I need to send files to multiple recipient automatically. The addresses and attachment names are in an Excel file.
This Outlook macro sends a message and attachment to a list of names in an Excel workbook.
The workbook should be designed like this:
Public Sub SendMessageAttachmentExcel()
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim rCount As Long
Dim bXStarted As Boolean
Dim enviro As String
Dim strPath As String
Dim strAttachPath As String
Dim olItem As Outlook.MailItem
Dim Recip As Outlook.Recipient
' Get Excel set up
enviro = CStr(Environ("USERPROFILE"))
'the path of the workbook
strPath = enviro & "\Documents\send.xlsx"
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
bXStarted = True
End If
On Error GoTo 0
'Open the workbook to input the data
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("Sheet1")
' Process the message record
On Error Resume Next
rCount = 2
strAttachPath = enviro & "\Documents\Send\" & xlSheet.Range("D" & rCount)
Do Until Trim(xlSheet.Range("A" & rCount)) = ""
'Create Mail Item and view before sending
Set olItem = Application.CreateItem(olMailItem)
With olItem
.To = xlSheet.Range("A" & rCount)
.CC = xlSheet.Range("B" & rCount)
.Subject = xlSheet.Range("C" & rCount)
.Body = "Attached is the file you need."
.Attachments.Add strAttachPath
.Display
.Send
End With
rCount = rCount + 1
Loop
Set xlWB = Nothing
Set xlApp = Nothing
End Sub
How to use this macro
First: You need to have macro security set to low during testing. The macros will not work otherwise.
To check your macro security in Outlook 2010 and above, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s at Tools, Macro Security.
After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.
Open the VBA Editor by pressing Alt+F11 on your keyboard.
Put this code in a module.
- Right click on Project1 and choose Insert > Module
- Copy and paste the macro into the new module.
More information as well as screenshots are at How to use the VBA Editor
Dom says
Hi Diane,
I'm looking in a business context to be able to send a separate email with varying data in excel but all to the same email address.
for example, in excel I have a report which has:
IDNumber System1Status System2Status
1 Working Ceased
2 Ceased Working
3 Suspended Working
4 Working Ceased
5 Working Suspended
6 Ceased Working
What I'm looking to do is send each row in the table 1x1 on a email such as this:
Hi,
Please see below. Can you resolve this discrepancy:
IDNumber: ABC
System1Status: DEF
System2Status: XYZ
Thanks.
BUT they all need to go to the same email address. The team can't accept a spreadsheet format and want 1 instance per email.
Any ideas please? Thanks in advance.
Rodrigo Montano says
Hello Diane, thankyou very much for this. I have a question. Turns out some of the addresses in my list are not valid (example@exampl..com (two dots) or example@example (no .com or any other termination). After the code reaches .send, Outlook pops the "Check Names" dialog, and the code stops running. How could I add a handler for those situations? So that when the email is not valid, it inputs cancel, and deletes the draft and continues with the next entry.. I want to leave the macro running all night and have thousands of emails.
Diane Poremsky says
It would probably be better to check the addresses as they are pulled from the database - you can use regex to validate the address
I think this pattern would work - ^[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,} - I'll try to take a look at it in the morning and put it together.
Rodrigo Montano says
Thankyou very much, your solution made more sense and it worked perfectly.
vijay says
Hi Diane, does this work with mailmerge as well?
Diane Poremsky says
Mail merge can use the workbook as a data source, but yeah, it can be used in place of mail merge. If you need the names (or other fields) in the body, there are a couple of options. There is a macro at https://www.slipstick.com/outlook/contacts/mail-merge-outlook-using-macro/ that shows how to fill in merge fields using a macro.
Jackieg653 says
BTW...I followed Fred's resolution below and THIS works fabulous!
Thanks Diane!
KJL says
I would be grateful if you could show the resolution in the code. I don't understand what code to move where.
Diane Poremsky says
Can you be more specific as to what you need help with? The macro as written will send mail to addresses in a spreadsheet. You don't need to move any code.
Jackieg653 says
Love this code so far, but when I generate 4 new emails (which are perfect) they each receive the same (first) attachment and not the one on their row.
Why????
Diane Poremsky says
What is the code you are using for the attachment path?
Abdul says
With olItem
.To = xlSheet.Range("A" & rCount)
.CC = xlSheet.Range("B" & rCount)
.Subject = xlSheet.Range("C" & rCount)
.Body = "Attached is the file you need."
.Attachments.Add strAttachPath
.Display
.Send
End With
There is an error happens in above block
Error code (91). could you please help me on this.
Diane Poremsky says
does the path for the attachment exist? Step through the macro - which line does it stop on?
Fred Cole says
The counter for the attachments would not increment where placed. Moved it to between the rCount increment and the Loop statement.
Fred Cole says
Just wanted to say thanks for your awesome work. This was exactly what I was looking for and worked perfectly.
sai krish says
how to attach a file ?
Diane Poremsky says
if the file name is in the excel workbook, you'd use this to set the path:
strAttachPath = enviro & "\Documents\Send\" & xlSheet.Range("D" & rCount)
if the entire path is in the file, use
strAttachPath = xlSheet.Range("D" & rCount)
if everyone gets the same file (and it's in a folder under your documents):
strAttachPath = enviro & "\Documents\Send\filename.ext"
and this to add it:
With olItem
.Attachments.Add strAttachPath
end with