Outlook Email Automation
Reports that contain a common theme are prevalent in any business. It’s not out of the ordinary for a company to report the same metric to several different organizational levels. Of course, company organizations have different hierarchies, and thus different email distribution lists. In order to send out a report to different business channels you may find yourself making a number of email drafts that contain similar content. Sometimes the only difference may be the email recipients. If this scenario sounds familiar, you can probably benefit from some basic task automation. Wouldn’t it be great if you could send out your list of reports with the mere click of a button?
If your answer was ‘Yes’, then you’re in the same situation as many working professionals. You have the desire to accomplish a time consuming or repetitive task so you can use your time doing more important core job responsibilities. You can use the two code examples below and the example file in order to accomplish this task.
VBA to send a single email:
Sub ExcelNationEmailAutomation() 'Declarations... Dim objOutApp As Object Dim ObjOutMail As Object On Error Resume Next 'Supress potential errors and continue code execution Set objOutApp = GetObject(, "Outlook.Application") If objOutApp Is Nothing Then 'Check to see if Outlook is open. objOutApp Is Nothing if Outlook is not open. Set objOutApp = CreateObject("Outlook.Application") 'Open Outlook if it was not already open End If Set ObjOutMail = objOutApp.CreateItem(0) 'Create New Outlook Mail Item With ObjOutMail .To = "" 'This is the To field .CC = "" 'This is the Carbon Copy field .BCC = "" 'This is the Blind Carbon Copy field .Subject = "This is my Excel Nation subject line..." 'This is the email Subject .Body = "Some Salutation Here-" & vbNewLine _ & "This is a new line of text under the salutation..." 'This is the email Body .Send 'You can use .Display if you would like to review the email content End With On Error GoTo 0 'Reset error handling End Sub
VBA to send multiple emails:
Sub ExcelNationEmailAutomationLoop() 'Declarations... Dim objOutApp As Object Dim ObjOutMail As Object On Error Resume Next 'Supress potential errors and continue code execution Lrow = Cells(Rows.Count, "B").End(xlUp).Row 'Define last row based on column B Set objOutApp = GetObject(, "Outlook.Application") If objOutApp Is Nothing Then 'Check to see if Outlook is open. objOutApp Is Nothing if Outlook is not open. Set objOutApp = CreateObject("Outlook.Application") 'Open Outlook if it was not already open End If 'Row 4 is the number that the email list starts at 'so we want to start the loop here for the first email 'We will continue to loop through the list until we get 'to the bottom of the list....i.e. Lrow (short for last row) For intLp = 4 To Lrow Set ObjOutMail = objOutApp.CreateItem(0) 'Create New Outlook Mail Item With ObjOutMail .To = Cells(intLp, "B") 'This is the To field (Column B) .CC = Cells(intLp, "C") 'This is the Carbon Copy field (Column C) .BCC = Cells(intLp, "D") 'This is the Blind Carbon Copy field (Column D) .Subject = Cells(intLp, "E") 'This is the email Subject .Body = Cells(intLp, "F") 'This is the email Body .Send 'You can use .Display if you would like to review the email content End With Next intLp On Error GoTo 0 'Reset error handling End Sub
This may not fit your needs exactly, but with a little modification the possibilities grow commensurately.
Example File(s)
Recent Posts
-
Posted on Sep 28, 2022
Sequence Function
-
Posted on Aug 25, 2021
Excel Nation is Alive!
-
Posted on Aug 24, 2021
Waffle Chart Visualization
-
Posted on Aug 24, 2021
Macros 101 - Task Automation