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注释快照中显示的代码位置