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

Question

我有一个 Access 2016 数据库，其中包含保存学生数据的表。我已经成功地使用 VBA-Outlook 向每个收件人发送了一封电子邮件（代码有效），但是，它似乎已经多次将电子邮件发送给相同的收件人（每个收件人随机重复 1 到 4 封电子邮件）。

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

当我在oEmailItem 中使用.Display 而不是.Send 时，似乎没有任何重复。或许我应该在循环中加入 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)

将任何空或空白字段更改为""。这样，我不需要每次都清空变量，因为查找将其更改为""，如果它仍然为空。 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