How to send email reminder from code

2019-09-24 10:34发布

站内问答 / 后端开发
1311 1 4 

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

Need code to email the values in columns AE with the "set reminder" text

enter image description here

1条回答
老娘就宠你
2楼-- · 2019-09-24 11:31

GD mjac,

You are still shy with your information...?

Your presented code collects all addresses and subsequently sends a single message ? I would expect, based on your example sheet/data that you would want to send an email to each recipient for each ECR code that is 'open' ?

So assuming the following:

  • You want to send an email for every line where the "Send reminder" is true
  • The email addresses in columns "AH" will differ for every line ?

In your code you use the Outlook.Application objects Set OutlookApp = CreateObject("Outlook.application"), be careful with opening application type objects and be sure to ensure they will be closed in the event the code finishes or when an error is triggered, otherwise you could potentially end up with a number of Outlook instances that are 'running' using valuable reqources. The below code has some basic error handling to ensure the OutlookApp object is closed if no longer required.

Setup your Workbook as follows:

In VB Editor under Tools|References find 'Microsoft Outlook xx.x Object Library', where xx.x represents the version of Outlook that you are working with. (see also: https://msdn.microsoft.com/en-us/library/office/ff865816.aspx) This will make for easier coding as you get intellisense suggestions for your objects.

Declare OutlookApp as public, above all other subs/functions etc. etc. (i.e. at the top of your 'coding' window)

Public OutlookApp As Outlook.Application

your sendReminderMail() sub

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

added sendMail Function:

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
查看更多
0人赞 添加讨论(0) 举报
登录 后发表回答
相关问题
查看全部
相关文章
查看全部
收藏的人(4)