如何从代码发送电子邮件提醒

时间:2015-10-18 00:40:19

标签: excel vba excel-vba

Sub SendReminderMail()
  Dim OutlookApp As Object
  Dim OutLookMailItem As Object
  Dim iCounter As Integer
  Dim MailDest As String

  Set OutlookApp = CreateObject("Outlook.application")
  Set OutLookMailItem = OutlookApp.CreateItem(0)

  With OutLookMailItem
    MailDest = ""

    For iCounter = 1 To WorksheetFunction.CountA(Columns(34))
      If MailDest = "" And Cells(iCounter, 34).Offset(0, -1) = "Send Reminder" Then
        MailDest = Cells(iCounter, 34).Value
      ElseIf MailDest <> "" And Cells(iCounter, 34).Offset(0, -1) = "Send Reminder" Then
        MailDest = MailDest & ";" & Cells(iCounter, 34).Value
      End If
    Next iCounter

    .BCC = MailDest
    .Subject = "ECR Notification"
    .HTMLBody = "Reminder: This is a test for an automatic ECR email notification. Please complete your tasks for ECR#"
    .Send
  End With

  Set OutLookMailItem = Nothing
  Set OutlookApp = Nothing
End Sub

需要使用“设置提醒”文字

通过电子邮件发送AE列中的值的代码

enter image description here

1 个答案:

答案 0 :(得分:1)

GD mjac,

你仍然对你的信息感到害羞......?

您提供的代码会收集所有地址,然后发送一条消息吗?我希望,根据您的示例表/数据,您希望为每个“开放”的ECR代码向每个收件人发送电子邮件?

假设如下:

  • 您想为“发送提醒”所在的每一行发送电子邮件 真
  • “AH”列中的电子邮件地址会因每行而有所不同吗?

在您的代码中使用Outlook.Application对象Set OutlookApp = CreateObject("Outlook.application"),请小心打开应用程序类型对象,并确保在代码完成或触发错误时关闭它们,否则您最终可能会有一些使用有价值的资源“运行”的Outlook实例。下面的代码有一些基本的错误处理,以确保OutlookApp对象在不再需要时关闭。

按如下方式设置工作簿:

在“工具”|“参考”下的“VB编辑器”中,找到“Microsoft Outlook xx.x对象库”,其中xx.x表示您正在使用的Outlook版本。 (另请参阅:https://msdn.microsoft.com/en-us/library/office/ff865816.aspx)当您获得对象的智能感知建议时,这将使编码更容易。

OutlookApp声明为公开,高于所有其他潜艇/功能等。 (即在“编码”窗口的顶部)

Public OutlookApp As Outlook.Application

您的sendReminderMail()子

Sub SendReminderMail()
  Dim iCounter As Integer
  Dim MailDest As String
  Dim ecr As Long

    On Error GoTo doOutlookErr:
    Set OutlookApp = New Outlook.Application

    For iCounter = 1 To WorksheetFunction.CountA(Columns(34))
        MailDest = Cells(iCounter, 34).Value
        ecr = Cells(iCounter, 34).Offset(0, -3).Value

        If Not MailDest = vbNullString And Cells(iCounter, 34).Offset(0, -1) = "Send Reminder" Then
          sendMail MailDest, ecr
          MailDest = vbNullString
        End If

    Next iCounter

'basic errorhandling to prevent Outlook instances to remain open in case of an error.
doOutlookErrExit:
    If Not OutlookApp Is Nothing Then
        OutlookApp.Quit
    End If
    Exit Sub

doOutlookErr:
    MsgBox Err.Description, vbOKOnly, Err.Source & ":" & Err.Number
    Resume doOutlookErrExit

End Sub

添加了sendMail功能:

Function sendMail(sendAddress As String, ecr As Long) As Boolean

    'Initiate function return value
    sendMail = False
    On Error GoTo doEmailErr:

    'Initiate variables
    Dim OutLookMailItem As Outlook.MailItem
    Dim htmlBody As String

    'Create the mail item
    Set OutLookMailItem = OutlookApp.CreateItem(olMailItem)

    'Create the concatenated body of the mail
    htmlBody = "<html><body>Reminder: This is a test for an automatic ECR email notification.<br>" & _
                "Please complete your tasks for ECR#" & CStr(ecr) & "</body></html>"

    'Chuck 'm together and send
    With OutLookMailItem

        .BCC = sendAddress
        .Subject = "ECR Notification"
        .HTMLBody = htmlBody
        .Send

    End With

    sendMail = True

doEmailErrExit:
    Exit Function

doEmailErr:
    MsgBox Err.Description, vbOKOnly, Err.Source & ":" & Err.Number
    Resume doEmailErrExit


End Function