如果公式值滿足條件，請發送Excel中的自動電子郵件

只有在列M（= IF（VAL.EMPTY（K15）;「」）中的公式值自動發送電子郵件時， ; MAX（K15-Today（）; 0））> 200。不幸的是，如果在列K中的公式值單元格中的條件被滿足（> 200），如果列K中的日期被手動更改，則觸發電子郵件代碼或者通過在列N中手動寫入不發送。相反，我的目標是： 1）瞭解爲什麼Sheet1中的這些代碼不會按照應有的方式自動發送電子郵件（它唯一的作用是將發送到第N列沒有發送電子郵件，這讓我覺得這段代碼的工作原理） 2）找到自動發送電子郵件的方式，而不用在我的sh中手動更改任何內容EET1。如果公式值滿足條件，請發送Excel中的自動電子郵件

  H   I  J    K   L   M   N 
     Date  Score Description  Next Due  Status Days till 
                   expiration  
15 28/09/2017 13 Medium Risk  25/07/2018  Valid  284   Sent 
16 11/10/2017 13 Medium Risk  10/08/2018  Valid  300   Sent 

'Sheet1 (FormulaValueChange) 

Private Sub Worksheet_Calculate() 
Dim FormulaRange As Range 
Dim NotSentMsg As String 
Dim MyMsg As String 
Dim SentMsg As String 
Dim MyLimit As Double 

NotSentMsg = "Not Sent" 
SentMsg = "Sent" 

'Above the MyLimit value it will run the macro 
MyLimit = 200 

'Set the range with the Formula that you want to check 
Set FormulaRange = Me.Range("M15:M16") 

On Error GoTo EndMacro: 
For Each FormulaCell In FormulaRange.Cells 
    With FormulaCell 
     If IsNumeric(.Value) = False Then 
      MyMsg = "Not numeric" 
     Else 
      If .Value > MyLimit Then 
       MyMsg = SentMsg 
       If .Offset(0, 1).Value = NotSentMsg Then 
        Call Mail_with_outlook1(FormulaCell) 
       End If 
      Else 
       MyMsg = NotSentMsg 
      End If 
     End If 
     Application.EnableEvents = False 
     .Offset(0, 1).Value = MyMsg 
     Application.EnableEvents = True 
    End With 
Next FormulaCell 

ExitMacro: 
Exit Sub 

EndMacro: 
Application.EnableEvents = True 

MsgBox "Some Error occurred." _ 
    & vbLf & Err.Number _ 
    & vbLf & Err.Description 

End Sub 

'Mail Code 

Option Explicit 

Public FormulaCell As Range 

Sub Mail_with_outlook1(FormulaCell As Range) 

Dim OutApp As Object 
Dim OutMail As Object 
Dim strto As String, strcc As String, strbcc As String 
Dim strsub As String, strbody As String 

Set OutApp = CreateObject("Outlook.Application") 
Set OutMail = OutApp.CreateItem(0) 

strto = "[email protected]" 
strcc = "" 
strbcc = "" 
strsub = "Assessement reminders" 
strbody = "Thanks a lot" 
With OutMail 
    .To = strto 
    .CC = strcc 
    .BCC = strbcc 
    .Subject = strsub 
    .Body = strbody 
    'You can add a file to the mail like this 
    '.Attachments.Add ("C:\test.txt") 
    .Display ' or use .Send 
End With 

Set OutMail = Nothing 
Set OutApp = Nothing 
End Sub

來源

2017-10-14 Tom

放於斷點到你的代碼，並跟蹤執行，因爲它的進展....擺脫'上error'線。它掩蓋了錯誤 – jsotola

我已經做到了，它似乎仍然可以工作 – Tom

所以它沒有任何區別，但電子郵件它還沒有發出 – Tom

你可以這樣做。

Sub Mail_small_Text_Outlook() 
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm 
'Working in Excel 2000-2016 
    Dim OutApp As Object 
    Dim OutMail As Object 
    Dim strbody As String 

    Set OutApp = CreateObject("Outlook.Application") 
    Set OutMail = OutApp.CreateItem(0) 

    strbody = "Hi there" & vbNewLine & vbNewLine & _ 
       "Cell A1 is changed" & vbNewLine & _ 
       "This is line 2" & vbNewLine & _ 
       "This is line 3" & vbNewLine & _ 
       "This is line 4" 

    On Error Resume Next 
    With OutMail 
     .To = "[email protected]" 
     .CC = "" 
     .BCC = "" 
     .Subject = "This is the Subject line" 
     .Body = strbody 
     'You can add a file like this 
     '.Attachments.Add ("C:\test.txt") 
     .Display 'or use .Send 
    End With 
    On Error GoTo 0 

    Set OutMail = Nothing 
    Set OutApp = Nothing 
End Sub

https://www.rondebruin.nl/win/s1/outlook/bmail9.htm

來源

2017-10-24 12:23:48 ryguy72

如果公式值滿足條件，請發送Excel中的自動電子郵件

回答

相關問題