Duplicate Attachment when Sending Email using Gmail in Excel VBA

[Kelvspogi]

What I am trying to do is to send multiple emails to multiple clients with a click of a button, with each client has a different attachment. I can already send an email with an attachment, however, the second recipient also received the previous attached file sent to the first client prior to him. So the first client on the list gets his/her correct attachment, the 2nd client gets his correct attachment plus the attachment of the previous client, and so on. This is my code:
On Error GoTo Err
<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">Dim NewMail As Object
Dim mailConfig As Object
Dim fields As Variant
Dim msConfigURL As String

Set NewMail = CreateObject("CDO.Message")
Set mailConfig = CreateObject("CDO.Configuration")

mailConfig.Load -1

Set fields = mailConfig.fields



With NewMail
.Subject = "Test Mail"
.From = "test@gmail.com"
.To = "test@gmail.com"
.CC = ""
.BCC = ""
.TextBody = "test email only"
.AddAttachment "D:\_WORK FILES\Scanned\Epson_1297.pdf"
End With

msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

With fields

.Item(msConfigURL & "/smtpusessl") = True


.Item(msConfigURL & "/smtpauthenticate") = 1



.Item(msConfigURL & "/smtpserver") = "smtp.gmail.com"
.Item(msConfigURL & "/smtpserverport") = 465
.Item(msConfigURL & "/sendusing") = 2


.Item(msConfigURL & "/sendusername") = "test@gmail.com"
.Item(msConfigURL & "/sendpassword") = "*******"

'Update the configuration fields
.Update

End With
NewMail.Configuration = mailConfig
NewMail.Send


With NewMail
.Subject = "Test Mail"
.From = "test@gmail.com"
.To = "test@gmail.com"
.CC = ""
.BCC = ""
.TextBody = "test email only"
.AddAttachment "D:\_WORK FILES\Scanned\Epson_1296.pdf"
End With

msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

With fields

.Item(msConfigURL & "/smtpusessl") = True


.Item(msConfigURL & "/smtpauthenticate") = 1


.Item(msConfigURL & "/smtpserver") = "smtp.gmail.com"
.Item(msConfigURL & "/smtpserverport") = 465
.Item(msConfigURL & "/sendusing") = 2


.Item(msConfigURL & "/sendusername") = "test@gmail.com"
.Item(msConfigURL & "/sendpassword") = "*****"

'Update the configuration fields
.Update

End With
NewMail.Configuration = mailConfig
NewMail.Send



MsgBox ("Mail has been Sent")</code>Exit_Err:
<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">Set NewMail = Nothing
Set mailConfig = Nothing
End</code>Err: Select Case Err.Number
<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">Case -2147220973
MsgBox " Could be no Internet Connection !! -- " & Err.Description

Case -2147220975
MsgBox "Incorrect Credentials !! -- " & Err.Description

Case Else
MsgBox "Error occured while sending the email !! -- " & Err.Description
End Select

Resume Exit_Err</code>Is there a way to fix this code to only send one specific and correct attachment to each specific client?
Thanks in advance.

 

[John_w]

Try adding, immediately after the first NewMail.Send:

<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">[FONT=inherit]
[/FONT]Set NewMail = Nothing
Set NewMail = CreateObject("CDO.Message")[FONT=inherit][/FONT]</code>

Please use CODE tags.