Outlook Send Same Email to Different Recipients | VBA Macro #31

Share on facebook
Share on twitter
Share on linkedin
To BCC or to not BCC?  That is the question that comes to mind when emailing a variety of different recipients.  This is especially important if you are working with multiple clients.  You can BCC recipients so they can’t click reply all. Recipients won’t see who was emailed but that is actually the problem.  The value is knowing who was emailed so customers know if additional follow-up is needed.  Instead you can CC recipients but once someone hits Reply All the conversation can get out of control.  This can create a bigger problem if the email thread is across multiple parties. Sending separate emails creates more value for the customer but how do you do this efficiently and effectively? You could create new emails do a lot of copying and pasting but this isn’t a sustainable process. Good news is there is always a better way with VBA! Our new Outlook macro makes sending the same email to different recipients so easy! The Send Same Email to Different Recipients macro takes the Active open email and sends it to all the email recipients indicated in the VBA code.  The great thing is you can indicate multiple recipients per email creating a completely separate email thread. To get started simply draft your email as normal but instead of clicking Send run this macro.  The Email Subject and Email Body will be used in every email created.  Also, any email attachments in the Active email will be attached as well!  By Default, the generated emails will display for review before sending.  You can easily customize this macro to automatically send them!!!

See it in Action!

Watch this video to see this macro in action.

The Code

Here is the code for this macro. Make sure the following References are setup before running it: Visual Basic For Applications, Microsoft Outlook 16.0 Object Library The CopyAtts portion of this code is leveraged from page 613 of Microsoft Outlook 2007 Programming by Sue Mosher.
'Leverage & Lean "Less Clicks, More Results"
Sub SendSameEmailDifferentRecipients()
' Means variable is in use
Dim Body As String '
Dim CCRecipients As String '
Dim EmailCounter As String '
Dim NewEmail As Object '
Dim oItem As MailItem '
Dim Outlook As Object '
Dim Recipients As String '
Dim Subject As String '
 
On Error GoTo LeverageLean

'From current email copy the Subject and Body
Set oItem = Application.ActiveInspector.CurrentItem
Subject = oItem.Subject
Body = oItem.HTMLBody

EmailCounter = 0
 
Do Until EmailCounter = ""
EmailCounter = EmailCounter + 1
If EmailCounter = "1" Then
Recipients = ""
CCRecipients = ""
ElseIf EmailCounter = "2" Then
Recipients = ""
CCRecipients = ""
ElseIf EmailCounter = "3" Then
Recipients = ""
CCRecipients = ""
ElseIf EmailCounter = "4" Then
Recipients = ""
CCRecipients = ""
ElseIf EmailCounter = "5" Then
Recipients = ""
CCRecipients = ""
Else 'No additional Recipients set so clear EmailCounter.
EmailCounter = ""
Recipients = ""
End If
 
If Recipients <> "" Then
Set Outlook = CreateObject("Outlook.Application")
Set NewEmail = Outlook.CreateItem(0)
NewEmail.To = Recipients 'Set Recipients indicated by EmailCounter above
NewEmail.CC = CCRecipients 'Set CCRecipients indicated by EmailCounter above
NewEmail.Subject = Subject 'Set Subject from the Current Email
NewEmail.HTMLBody = Body 'Set Body from the Current Email
If oItem.Attachments.Count > 0 Then
Call CopyAtts(oItem, NewEmail) 'Call Macro to Copy Attachments from one Email to another
End If
NewEmail.Display
'NewEmail.Send
End If
 
Loop
 
Exit Sub
 
LeverageLean:
MsgBox (Err.Number & " - " & Err.Description & vbNewLine & vbNewLine & "Don't hesitate to email me: brentschneider@leveragelean.com")
    
End Sub
Sub CopyAtts(Source, Target) 'p.613-Microsoft Outlook 2007 Programming-Sue Mosher
Dim objFSO, fldTemp, strpath, strFile
Dim objAtt, blnUseTempFile
Const olByRefernce = 4
Const olByValue = 1
Const olEmbeddeditem = 5
Const TemporaryFolder = 2
 
 Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set fldTemp = objFSO.GetSpecialFolder(TemporaryFolder)
   strpath = fldTemp.Path & "\"
   For Each objAtt In Source.Attachments
    Select Case objAtt.Type
        Case olByReference
            strFile = objAtt.PathName
            blnUseTempFile = False
        Case olByValue, olEmbeddeditem
            strFile = strpath & objAtt.Filename
            objAtt.SaveAsFile strFile
            blnUseTempFile = True
        End Select
        If blnUseTempFile Then
        Target.Attachments.Add strFile, olByValue
        objFSO.DeleteFile strFile
        Else
        Target.Attachments.Add strFile, olByReference
        End If
   Next
 
   Set fldTemp = Nothing
   Set objFSO = Nothing
 
End Sub
'Stay Awesome

Macro Monday

Here is the Macro Monday video this macro was featured in. Watch this video to learn how to get the most out of this macro and start using it today!

Customization

These lines of code can be customized to personalize this macro.
24 through 38 Recipients = “” CCRecipients = “” To add Recipients and CC Recipients update these variables with email addresses throughout these code lines.
55. ‘NewEmail.Send To automatically send these generated emails remove the ‘ so this code lines is no longer a comment.
Subscribe
Notify of
0 Comments
Inline Feedbacks
View all comments

First time using VBA?

The Developer Tab is an additional section of the ribbon when activated allows you access to Visual Basic in Applications like Access, Excel, Outlook, PowerPoint, Word.
Setup Now
Once the Developer Tab is available you will have the capability to update your security to allow Macros to run in the current application.
Setup Now
A sub of code is a collection of objects and variables. For the code to successfully run a library of references needs to be set.
Setup Now
Subscribe as an Insider to receive additional rights.
If you like our content and want to show your support tip us here!

Contact Us

Looking to improve your computer processes?
Leverage & Lean is here to help!

Leverage & Lean

Is focused on improving computer processes by Leveraging programming and applying Lean principles. It is our goal to make you more efficient and effective on your computer producing “Less Clicks and More Results!”