Access 2016 processing duplicate mail to Outlook via VBA

Question

I have an Access 2016 database with tables that hold student data. I have managed to successfully send an email to each recipient using VBA-Outlook (the code works), however, it looks to have sent the the email to the same recipients multiple times (random duplicate of 1 to 4 emails per recipient).

I can confirm that there are no duplicate [E-mail Address] whatsoever contained within the Student table.

When I use .Display instead of .Send in my oEmailItem, there does not appear to be any duplicates. Perhaps I should include a waiting period of 1 second in the loop?

On Error Resume Next is used to bypass the null value returned by blank email fields; not everyone has an [E-mail Address] in this table

Why is this code sending random duplicate email to recipients?

Private Sub SendEmail_Click()

Dim rS As DAO.Recordset
Dim dbS As DAO.Database
Dim Filepath As String
Dim Folderpath As String
Dim oOutlook As Outlook.Application
Dim oEmailItem As MailItem
Dim myemail As String
Dim Subjectline As String

Subjectline$ = InputBox$("Please enter the subject line for this mailing.", _
"We need a Subject Line!")

Set dbS = CurrentDb()
Set rS = dbS.OpenRecordset("SELECT * FROM Students")

Do While Not rS.EOF
On Error Resume Next
myemail = rS![E-mail Address]

If oOutlook Is Nothing Then
    Set oOutlook = New Outlook.Application
End If

'Set the email template
Set oEmailItem = oOutlook.CreateItemFromTemplate("C:\MailTemplate\Mail1.oft")

With oEmailItem
    .To = [myemail]
    .Subject = Subjectline$
    .Send
End With
'End of emailing

rS.MoveNext
Loop
Set oEmailItem = Nothing
Set oOutlook = Nothing
Set rS = Nothing
Set dbS = Nothing

End Sub

Update: Thanks HiPierr0t. Your answer showed me that I wasn't emptying the variable at the end of the loop; thus assigning the previously used [E-mail Address] when met with a null or blank email field.

I did have to keep

Set oEmailItem = oOutlook.CreateItemFromTemplate("C:\MailTemplate\Mail1.oft")

inside the loop however (strange, must be a MS thing).

I ended up removing On Error Resume Next as it does create more problems, and used

myemail = Nz(rS![Email Address], vbNullString)

to change any null or blank fields into "". That way, I don't need to empty to variable each time as the lookup changes it to "" if it's null anyway. The If..Else takes care of the rest.

Do While Not rS.EOF
'On Error Resume Next
myemail = Nz(rS![Email Address], vbNullString)

Set oEmailItem = oOutlook.CreateItemFromTemplate("C:\MailTemplate\Mail1.oft")

If myemail = "" Then
    rS.MoveNext
Else
    With oEmailItem
    .To = [myemail]
    .Subject = Subjectline$
    .Display
    End With
    'End of my emailing report
    rS.MoveNext
End If
Loop

Googled around a bit. Another user fixed a similar issue by putting the code in a module. social.technet.microsoft.com/Forums/en-US/… — Pants

HiPierr0t HiPierr0t · Accepted Answer · 2018-09-12T17:41:21

On Error Resume Next tends to create more problems than it solves.

If no email exists, your code goes on. However your variable myemail is still filled with the previous email you sent an email to.

1- Make sure to empty your variable after the email is sent with myemail = "" or myemail = vbNullString.
2- Before sending the email, check that myemail is not empty with an If statement.
3- You may want to place your code below outside of the loop. It won't make a big difference but there is no need to process this part of code every time.

If oOutlook Is Nothing Then
    Set oOutlook = New Outlook.Application
End If

'Set the email template
Set oEmailItem = oOutlook.CreateItemFromTemplate("C:\MailTemplate\Mail1.oft")

Access 2016 processing duplicate mail to Outlook via VBA

2 Answers