Hello Guru’s
I would require your help on below requirement. I am new in VBA script this is my first attempt.
Currently am sending mails one by one with manual change in below code. Now I am planning to change code in automation way.
I have excel with data as below.
| SNO | Name | Mail ID | Amount | PDF attachement path |
| 1 | vardhan | [email protected] | 1000 | D:vardhan.pdf |
| 2 | vihas | [email protected] | 1000 | D:vihas.pdf |
| 3 | satya | [email protected] | 1000 | D:Satya.pdf |
| 4 | varun | [email protected] | 1000 | D:Varun.pdf |
Based on above cell values need to send mail each one with pdf attachment in separately with one click.
Currently am using below code changing values manually one by one. It is consuming time.
Code :-
Sub send_email_via_Gmail()
Dim myMail As CDO.Message
Set myMail = New CDO.Message
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") ="[email protected]"
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxx"
myMail.Configuration.Fields.Update
With myMail
.Subject = "Test Email from Dr.xxx"
.From = "[email protected]"
.To = "[email protected]"
.CC = "[email protected]"
.BCC = ""
.TextBody = "Good morning!"
.AddAttachment "D:xxx.txt"
End With
On Error Resume Next
myMail.Send
'MsgBox ("Mail has been sent")
Set myMail = Nothing
End Sub
Can you please help or provide me code which is similar for my requirement. Highly appreciated.
Hi,
I updated our code and inserted a loop. Make sure you change the column letters as needed, at this moment they are all pointing to column A to take data from, change the column in Tbl.Cells(i, "A").Value:
Sub send_email_via_Gmail()
Dim myMail As CDO.Message
Set myMail = New CDO.Message
Dim Tbl as Worksheet, i as long
Set Tbl=ThisWorkbook.Worksheets("Sheet1")
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") ="[email protected]"
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxx"
myMail.Configuration.Fields.Update
For i= 2 to tbl.Cells.Find("*", Tbl.Cells(1), , , xlByRows, xlPrevious).Row
With myMail
.Subject = "Test Email from Dr." & Tbl.Cells(i, "A").Value
.From = Cstr(Tbl.Cells(i, "A").Value)
.To = Cstr(Tbl.Cells(i, "A").Value)
.CC = Cstr(Tbl.Cells(i, "A").Value)
.BCC = ""
.TextBody = "Good morning!"
.AddAttachment Cstr(Tbl.Cells(i, "A").Value)
End With
'On Error Resume Next
myMail.Send
Next
'MsgBox ("Mail has been sent")
Set myMail = Nothing
End Sub
Hi It worked but the attachment macro seems to add all the attachments for each sender. Could you please see if there is an alternative coding you can suggest?
Hi,
You can reorganize the code:
Dim Tbl as Worksheet, i as long
Set Tbl=ThisWorkbook.Worksheets("Sheet1")
For i= 2 to tbl.Cells.Find("*", Tbl.Cells(1), , , xlByRows, xlPrevious).Row
send_email_via_Gmail i, Tbl
Next
End Sub
Sub send_email_via_Gmail(ByVal i as long, Byval Tbl as ListObject)
Dim myMail As CDO.Message
Set myMail = New CDO.Message
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") ="[email protected]"
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxx"
myMail.Configuration.Fields.Update
With myMail
.Subject = "Test Email from Dr." & Tbl.Cells(i, "A").Value
.From = Cstr(Tbl.Cells(i, "A").Value)
.To = Cstr(Tbl.Cells(i, "A").Value)
.CC = Cstr(Tbl.Cells(i, "A").Value)
.BCC = ""
.TextBody = "Good morning!"
.AddAttachment Cstr(Tbl.Cells(i, "A").Value)
'On Error Resume Next
.Send
End With
'MsgBox ("Mail has been sent")
Set myMail = Nothing
End Sub
Catalin Bombea,
You're A Genius!
Catalin Bombea,
Could you please help me out for the coding for gmail to draft the email but not send it.
For outlook its .Display but for gmail, been trying many ways, no luck!
would be of great help! Thx
Not possible.
That's CDO (not gmail) and it's a library, not an email client like outlook.
Oh ok. Actually i want to add my default signature before sending emails. Is there any way i can do that?
thanks for all your advice!
CDO is not outlook, thought I just mentioned that.
Are you sure you have a CDO signature? To help you answer this question, there is no signature in CDO, you might have one in an EMAIL CLIENT (like outlook, thunderbird).
Where is your default signature?
Just format the .HTMLBody in cdo (instead of .TextBody) to build your signature directly in code.
