One of my collegues wanted me to write an Excel VBA Macro to send same or similar (differing in the salutation, etc) emails taking one address at a time which he has added in an MS-Excel file. So in short, we need a program that reads something called a To List from the an MS-Excel file, modifies the mail slightly by changing the subject and the salutation etc. The code is simple and can be obtained from any website which gives tutorials in MS-Excel VBA. I wanted to go a step furthur and add pictures to the email body that we are sending. MS-Excel VBA is more kind of a self taught thing for me and you can do same by creating objects belonging to different class and exploring the attributes and function attached to them.
Coming back to the issue in hand. I have presented the code below which I have added as a Worksheet level macro to the only Worksheet that is present in the MS-Excel file (just to simplify stuff, you can complicate the same at your level or create a new code all together). The code I have written sends an HTML message (the workaround I thought of to kind of embed the image in the email). HTML also gave me greater flexibility for designing the mail in anyway I wanted to. The message is almost identical for each of the recipients whose email Id has been specified in a Range that is named “ToList” in the code and the email is sent individually to each of the recipients using a For Each Loop. I have messed up the code with lots of inline comments, which I feel should help even though the code is self explanatory. Following is the code
Sub emailingProgram() Dim olapp As Outlook.Application Dim objmail As Outlook.mailitem Dim pos As Integer Set olapp = Outlook.Application For Each xcell In Sheets("Sheet1").Range(Range("tolist"), _ Range("tolist").End(xlDown)) msgText = Range("Msg") xcell.Activate ActiveCell.Offset(0, 1).Select 'If you think that the email ID is in the pattern email@example.com use this if block 'The code will go into the else statement if the First Name is not mentioned If Selection.Value = "" Then pos = InStr(1, xcell.Value, ".") Fname = Mid$(xcell.Value, 1, InStr(1, xcell.Value, ".") - 1) Else 'If you have mentioned the first names in the First Name column this part will read it directly Fname = Selection.Value End If 'For each of the cells present in the To List we create a MailItem and send it Set objmail = olapp.CreateItem(olMailItem) objmail.BodyFormat = olFormatRichText 'Setting the subject, I have kept a Happy Birthday, Change as per your wish objmail.Subject = "Happy Birthday " + UCase(Mid$(Fname, 1, 1)) + Mid$(Fname, 2) 'Uncomment the following line of code in case you want to send a plain message 'objmail.Body = "Hi " + UCase(Mid$(Fname, 1, 1)) + Mid$(Fname, 2) + "," + Chr(13) + Chr(10) + msgText 'For using an image in your mail or an HTML body for styling objmail.HTMLBody = "<p><font size='6' face='arial' color='red'><i>Dear " & UCase(Mid$(Fname, 1, 1)) + Mid$(Fname, 2) & "<br></font></p><br><p align='CENTER'><font size='5' face='COMIC SANS' color='RED'>Wishing you a Wonderful Birthday</p><br><br></font><p align='CENTER'><a href='http://www.abrahamsarah.com'><img src='http://www.abrahamsarah.com/bilder/Happy-Birthday005.png' width=450 height=412 border=0></a></a><br><br><br><p align='left'>Thanks & Regards <br><br/> _<p><p align='left'><br>Anshuman Pandey<br>http://www.anshumusing.co.in/</p>" objmail.To = xcell.Value objmail.Send Set objmail = Nothing Next xcell End Sub
Just incase you get confused with the code and the Ranges I have named as it is not a stand alone module, here is a MS-Excel file that uses this code.
Word of Caution: To execute this code, you need to choose additional libraries. For choosing libraries, from the menu bar in the VBE go to Tools -> References and make sure that the check boxes are marked as shown below: