Excel：根據單元格內容發送Outlook電子郵件

Question

我樂意去學：

如果某個日期（D列）中的日期比日期晚16天，我們如何將Outlook電子郵件發送到另一列C中列出的電子郵件地址（格式：name@abc.com）。 如果日期晚於單元格D1中的日期16天並且單元格E1為空白（無文本），則應將電子郵件發送到C1中的電子郵件地址。

另外，如何設置電子郵件的正文，以便可以通過將文本插入另一列B中來將字符串插入正文中。 發送到單元格C1中電子郵件地址的電子郵件正文應在單元格B1中包含文本字符串。

Answer 1

請在Worksheet_Change的代碼頁上添加一個Worksheet_Change _ Worksheet_Change事件，其中包含快照中顯示的數據。按F11鍵打開VB編輯器。 然后單擊工作表，它將打開工作表的代碼頁。 從下拉列表中選擇更改，然后將一個例程添加到代碼頁。 在該例程中插入代碼。

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Column = 7 Then   'e.g. for column G
          Sendmail   'name of your sub
    End If

End Sub

我們的工作表設置如下圖所示。

我考慮了以下幾點。

• 僅應有一個警報，系統不應自動發送郵件而不進行審查。 很多情況下，工作表事件會產生意外的結果，因為此處需要特別注意。
• 為了提供最新狀態，我在F2單元格中輸入了以下公式，根據D2單元格中的日期和E2狀態，該公式將為"YES"或"NO" 。
• 為了使工作表事件正常運行，必須單擊Column G的單元格。 我在單元格G2添加了一個表單控制按鈕。 當狀態為是時，單擊G2的按鈕發送郵件。
• 現在，在VBE的工作簿中插入一個模塊，並將Sendmail的代碼放入該模塊中。

• 主題位於單元格F1 ，除了一般稱呼之外，消息正文位於單元格B1 ，收件人的名稱位於單元格C2

   Sub Sendmail() ' Display a message when one of the designated cells has been ' changed. ' Place your code here. Dim answer As String Dim SubmitLink As String Dim KeyCells As Range Set KeyCells = Range("F2:F100") SubmitLink = Range("B1").Value answer = MsgBox("Do you wish to save this change. An Email will be sent to the User", vbYesNo, "Save the change") If answer = vbNo Then Cancel = True If answer = vbYes Then Application.EnableEvents = False Application.ScreenUpdating = False 'open outlook type stuff Set OutlookApp = CreateObject("Outlook.Application") Set OlObjects = OutlookApp.GetNamespace("MAPI") Set newmsg = OutlookApp.CreateItem(olMailItem) On Error Resume Next 'add recipients 'newmsg.Recipients.Add ("Name Here") newmsg.Recipients.Add Worksheets("Sheet1").Range("C2").Value 'add subject newmsg.Subject = Worksheets("Sheet1").Range("F1").Value 'add body newmsg.Body = "Dear Customer, " & SubmitLink & vbLf & vbLf & vbLf & " Look Forward to your confirmation" & vbLf & vbLf & vbLf & "Sincerely," & vbLf & "Customer Care department" newmsg.Display 'display newmsg.Send 'send message 'give conformation of sent message MsgBox "Modification confirmed", , "Confirmation" End If ' MsgBox "Cell " & Target.Address & " has changed." On Error GoTo 0 Set newmsg = Nothing Set OutlookApp =Nothing End Sub 

編輯：OP注釋快照中顯示的代碼位置