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
与恶龙缠斗过久,自身亦成为恶龙；凝视深渊过久,深渊将回以凝视…
