Excel：根据单元格内容发送Outlook电子邮件

Question

我想学习：

当某个日期（D列）中的日期晚16天后，我们如何将前瞻性电子邮件发送到另一列C中列出的电子邮件地址（格式：name@abc.com）。如果日期晚于单元格D1中的日期16天并且单元格E1为空白（无文本），则应将电子邮件发送到C1中的电子邮件地址。

此外，如何设置电子邮件的正文，以便可以通过将文本插入另一列B来将字符串插入正文中。发送到单元格C1中电子邮件地址的电子邮件正文应在单元格B1中包含文本字符串。

Answer 1

请在工作表的代码页上添加一个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单元格中输入了以下公式，具体取决于"YES"单元格中的日期和"NO"的状态，它们将是D2或E2 。
• 要使工作表事件正常运行，必须单击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注释快照中显示的代码的位置