In this blog, I will try to cover how to get rid of Mail Merge by using the sample Excel VBA code. We all know how to do the mail merge in MS Word. But today I will discuss on mail merge in Excel. The data in your spreadsheet and you want to send the mail to the multiple people at a time.
For example, in your spreadsheet, you have the data like Firstname, Lastname, Email-id, Date of Birth and phone numbers. You have a long list like this. Now every day you need to check the date of birth and send the email to the associated person.
Now I can show you how to write a simple VBA code that will check the date of birth and then send the email using either email or from your outlook.
Let’s assume you have the sample the data like below in a sheet called “DataSheet”(Picture 1)
It’s simple data set of the employee. We need to check whose birth date is today and then you need to send an email.
Now I will show you how to write a simple that will check the birthday of the employees and sent them email from your outlook or Gmail taking the email id from the sheet.
- We will create a simple template for out later reference. I have added a new sheet and changed the name of the sheet as “Mail Merge”.
- Then I have created a simple template like below.
I have created this template in Excel using page layout. I have inserted a picture in the corner which is downloaded from the internet. In future, if you want to take the print out of the birthday boys it will work.
Now you need to write the code. Press Alt +F11 to go to VBA page. Then Click on insert and then click on Module.
After creating the new module copy the below code and then paste the below code in the module. We will catch the code one by one line later. This code is applicable when you are sending from your Gmail id.
Interesting posts on Excel VBA: Merge workbooks into single spreadsheet
Before pasting the code in the module, make sure that Microsoft CDO for windows 2000 library check box is on. To check the same just follow the below steps.
- Click on Tools
- Then go to References
- Microsoft CDO for windows 2000 library
If this is not checked then please tick the box and then press OK.
Then you need to paste the below code in the module.
Sub sendemail() Dim ws As Worksheet Dim ws1 As Worksheet Dim Lr As Integer Dim bdate As Range Dim firstName As String Set ws = Sheets("DataSheet") ' Your data sheet. Set ws1 = Sheets("MailMerge") ' Your template sheet Set myMail = New CDO.Message Lr = ws.Cells(Rows.Count, 1).End(xlUp).Row ' to get the last row no in your datasheet file For i = 2 To Lr Application.ScreenUpdating = False Set bdate = ws.Range("D" & i) checking = (Format(bdate, "mmm-dd") = Format(Date, "mmm-dd")) ' Birthday checking with today's date ws.Cells(i, 8).value = checking If ws.Cells(i, 8).value = True Then firstName = ws.Cells(i, 2) msg = "Dear " & firstName & "," & vbCrLf & vbCrLf Dim iMsg As Object Dim iConf As Object Dim strbody As String Dim Flds As Variant Set iMsg = CreateObject("CDO.Message") Set iConf = CreateObject("CDO.Configuration") iConf.Load -1 ' CDO Source Defaults Set Flds = iConf.Fields With Flds .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "[email protected]" .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "yourpassword" .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 .Update End With strbody = "Hello" & fristname & "," & vbNewLine & vbNewLine & _ "Celebrate your birthday today. Celebrate being Happy every day." & vbNewLine & vbNewLine & _ "Hoping you get a big promotion and an even bigger pay raise this year." & vbNewLine & vbNewLine & _ "You deserve it. Besides, it's about time you picked up our lunch tab. " & vbNewLine & vbNewLine & _ vbNewLine & vbNewLine & _ vbNewLine & vbNewLine & _ "Happy Birthday to you!!!" & vbNewLine & vbNewLine & _ vbNewLine & vbNewLine & _ "Niladri Sekhar Biswas" With iMsg Dim email As String email = ws.Range("G" & i).value Set .Configuration = iConf .To = email .CC = "" .BCC = "" ' Note: The reply address is not working if you use this Gmail example ' It will use your Gmail address automatic. But you can add this line ' to change the reply address .ReplyTo = "[email protected]" .From = """Test"" <[email protected]>" .Subject = "Important message" .TextBody = strbody .AddAttachment "E:\happy_birthday_card.jpg" .Send MsgBox "Mail send" End With End If Next Application.ScreenUpdating = True End Sub
You need to change the references as per your data. In my case date of birth is in D column and email id is present in G Column. And in H column I have checked where the date of birth is today or not.
You might also like to read about this: Learn more about: Tricks of Text to Columns in MS Excel
Now go back to MailMerge sheet and then insert a shape. And then right click on it and then click on assign macros and select the name the procedure you have pasted just now.
Now if you click on the shape then it will call your Sendmail procedure and it will send email from your Gmail account. But before that, you need to give a valid user name and your Gmail password.
If your less secure app is off in your Gmail account then probably you will not able to deliver the email. So before hit the button go back to your Gmail account and set less secure app is on.
Code for using Outlook:
Dim Outlook As Object Dim Email As Object Dim ws As Worksheet Dim ws1 As Worksheet Dim address As Range, rngCell As Range Dim Recipients As String Dim Lr As Integer Dim i As Integer Dim msg As String Dim bdate As Range Set ws = Sheets("DataSheet") ' Your data sheet. Set ws1 = Sheets("MailMerge") Lr = ws.Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To Lr Set Outlook = CreateObject("Outlook.Application") Set Email = Outlook.CreateItem(0) Set bdate = ws.Range("D" & i) checking = (Format(bdate, "mmm-dd") = Format(Date, "mmm-dd")) ' Birthday checking with today's date ws.Cells(i, 8).value = checking If ws.Cells(i, 8).value = True Then firstName = ws.Cells(i, 2) Recipients = ws.Range("G" & i).value msg = "" msg = msg & "Dear " & firstName & "," & vbCrLf & vbCrLf msg = msg & "Celebrate your birthday today. Celebrate being Happy every day. " & vbCrLf & vbCrLf msg = msg & "Hoping you get a big promotion and an even bigger pay raise this year. Happy Birthday to you!!!" & vbCrLf & vbCrLf msg = msg & "Thanks" & vbCrLf & vbCrLf msg = msg & "Kind Regards" & vbCrLf & vbCrLf msg = msg & "Niladri Sekhar Biswas" Email.Importance = 2 Email.Subject = "Happy Birthday!!!" Email.Body = msg 'Email.Attachments.Add ActiveWorkbook.FullName 'Set Recipient Email.To = Recipients Email.Send End If Next MsgBox "Email Sent Successfully" End Sub
This code will help you to send the email from outlook:
Further, let me know if you created a variant for this? Happy to discuss new ideas 🙂