访问2016通过VBA处理重复邮件到Outlook

Question

我有一个Access 2016数据库，其中包含保存学生数据的表。我已经设法使用VBA-Outlook成功向每个收件人发送电子邮件（代码可以工作），但是，它看起来已经多次将电子邮件发送给相同的收件人（每个收件人随机复制1到4封电子邮件）。

我可以确认[E-mail Address]表中没有任何重复的Student。

当我在我的.Display中使用.Send而不是oEmailItem时，似乎没有任何重复。也许我应该在循环中包括1秒的等待时间？

On Error Resume Next用于绕过空白电子邮件字段返回的空值;不是每个人都有这张表中的[E-mail Address]

为什么此代码会向收件人发送随机重复的电子邮件？

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

更新：感谢HiPierr0t。你的回答告诉我，我没有在循环结束时清空变量;因此，当遇到空或空白电子邮件字段时，分配以前使用的[E-mail Address]。

我确实要保持

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

但是在循环内部（奇怪，必须是MS的东西）。

我最终删除了On Error Resume Next，因为它确实产生了更多的问题，并且使用了

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

将任何null或空白字段更改为""。这样，我不需要每次都变空，因为查找将其更改为""，如果它仍为null。 If..Else负责其余部分。

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

Answer 1

On Error Resume Next往往会产生比解决更多的问题。

如果不存在电子邮件，则代码会继续。但是，您的变量myemail仍然填充了您发送电子邮件的上一封电子邮件。

1-确保在使用myemail = ""或myemail = vbNullString发送电子邮件后清空变量。 2-在发送电子邮件之前，使用If语句检查myemail是否为空。 3-您可能希望将代码放在循环外部。它不会产生很大的不同，但每次都不需要处理这部分代码。

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

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

Answer 2

在发送电子邮件之前，请检查您是否清空了电子邮件。

您还需要在循环后添加“rS.Close dbS.Close”。

这是完整的代码：

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 = ""
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

rS.Close
dbS.Close

Set oEmailItem = Nothing
Set oOutlook = Nothing
Set rS = Nothing
Set dbS = Nothing

End Sub