Access 2016 обрабатывает дубликаты почты в Outlook через VBA - PullRequest
Новая
       35

Access 2016 обрабатывает дубликаты почты в Outlook через VBA

0 голосов
/ 12 сентября 2018

У меня есть база данных Access 2016 с таблицами, которые содержат данные об учениках.Мне удалось успешно отправить электронное письмо каждому получателю с помощью VBA-Outlook (код работает), однако, похоже, что оно отправляло электронное письмо одним и тем же получателям несколько раз (случайная копия от 1 до 4 писем на получателя).

Я могу подтвердить, что в таблице Student нет дубликатов [E-mail Address].

Когда я использую .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)

, чтобы изменить пустые или пустые поля на "".Таким образом, мне не нужно каждый раз очищать переменную, так как поиск изменяет ее на "", если она все равно равна нулю.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

Ответы [ 2 ]

0 голосов
/ 13 сентября 2018

Перед отправкой электронной почты проверьте, не опустели ли вы мою электронную почту.

Также вам нужно добавить «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
0 голосов
/ 12 сентября 2018

On Error Resume Next имеет тенденцию создавать больше проблем, чем решает.

Если адрес электронной почты не существует, ваш код продолжается.Однако ваша переменная myemail по-прежнему заполнена предыдущим письмом, на которое вы отправили электронное письмо.

1- Обязательно очистите переменную после того, как письмо отправлено с myemail = "" или myemail = vbNullString,2- Перед отправкой электронного письма убедитесь, что myemail не пусто с оператором If.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")
...