Duplicate Attachment when Sending Email using Gmail in Excel VBA

Kelvspogi

New Member
Joined
Jul 18, 2019
Messages
1
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.
 

Some videos you may like

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,410
Try adding, immediately after the first NewMail.Send:
Code:
<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.
 

Watch MrExcel Video

Forum statistics

Threads
1,108,579
Messages
5,523,700
Members
409,532
Latest member
Lmfacc

This Week's Hot Topics

Top