With a macro from Excel, you can create an email in Outlook that will attach your active workbook and fill in the To field with a list of multiple recipients. Suppose you have a workbook that you email to the same people on a regular basis. On a hidden worksheet, you can list all the recipients’ email addresses, such as I have done in column A of Sheet3.
This macro will create an email in Outlook, attach your workbook, and write your list of recipients in the To field as seen in the following picture.
Sub EmailAttachmentRecipients()
'Declare and establish the Object variables for Outlook.
Dim objOutlook As Object
Dim objNameSpace As Object
Dim objInbox As Object
Dim objMailItem As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objInbox = objNameSpace.Folders(1)
Set objMailItem = objOutlook.CreateItem(0)
'Declare a String variable for the recipient list, and an Integer variable
'for the count of cells in column A that contain email addresses.
Dim strTo As String
Dim i As Integer
strTo = ""
i = 1
'Loop through the recipient email addresses to build a continuous string
that separates recipient addresses by a semicolon and a space.
With Worksheets("Sheet3") 'change sheet name where list is kept.
Do
strTo = strTo & .Cells(i, 1).Value & "; "
i = i + 1
Loop Until IsEmpty(.Cells(i, 1))
End With
'Remove the last two characters from the recipient string, which are
'an unnedded semicolon and space.
strTo = Mid(strTo, 1, Len(strTo) - 2)
'Display the email message with the attached active workbook.
With objMailItem
.to = strTo
.CC = "CEO@yourcompany.com; President@yourcompany.com"
.Subject = "Example attachment to multiple recipients"
.Body = _
"Hello everyone," & Chr(10) & Chr(10) & _
"Here's an example for attaching the active workbook" & Chr(10) & _
"to an email with multiple recipients."
.Attachments.Add ActiveWorkbook.FullName
.Display 'Change to Send if you want to just send it.
End With
'Release object variables from system memory.
Set objOutlook = Nothing
Set objNameSpace = Nothing
Set objInbox = Nothing
Set objMailItem = Nothing
End Sub
Follow Us
