VBA - Send multiple emails with multiple different attachments

[ElisabtehF20]

Hi,

I'm not really good at VBA. I was able to change a macro find on the internet (see below)
I'd like to send multiple attachments. For now, 2 but might be more in the future.
both attachments (PDF file, for now) must be sent to a specific group (TO + CC + BCC). 2 differents files per group
Files paths change every month.
Is that possible to add that in my current macro?

Thanks a lot for your help


Sub Send_email_EOMDocuments()
Dim Email_Address_1 As String
Dim Subject As String
Dim Email_Address_2 As String
Dim CC As String
Dim message As String
Dim filename As String
Dim outlookapp As Object
Dim outlookmailitem As Object
Dim myAttachments As Object
Dim Path As String
Dim lastrow As Integer
Dim Attachment As String
Dim x As Integer

x = 3

Do While Sheet1.Cells(x, 1) <> ""

Set outlookapp = CreateObject("Outlook.Application")
Set outlookmailitem = outlookapp.CreateItem(0)
Set myAttachments = outlookmailitem.Attachments
Path = Sheet1.Cells(x, 5)
Email_Address_1 = Sheet1.Cells(x, 1)
Email_Address_2 = Sheet1.Cells(x, 2)
CC = Sheet1.Cells(x, 3)
Subject = Sheet1.Cells(x, 4)
filename = Sheet1.Cells(x, 6)
Attachment = Path + filename

outlookmailitem.To = Email_Address_1
outlookmailitem.CC = Email_Address_2
outlookmailitem.BCC = CC
outlookmailitem.Subject = Subject
outlookmailitem.Body = "Please find your end of month documents attached "

myAttachments.Add (Attachment)
outlookmailitem.Display
outlookmailitem.send

lastrow = lastrow + 1
Email_Address_1 = ""
x = x + 1

Loop

Set outlookapp = Nothing
Set outlookmailitem = Nothing


MsgBox "All the documents have been sent"

End Sub

[Mumps1]

Currently you have one filename in cells(x,6). Where is the name of the second file you want to attach? It would be easier to help and test possible solutions if you could attach a copy of your file. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary). See the yellow banner at the top of this page for instructions to attach a file.

[ElisabtehF20]

I can't attach a file because I'm new.

I'd like to add :
cells(x,7) = Path doc 2
cells(x,8) = FileName Doc 2

I have
cells(x,5) = Path Doc 1
cells(x,6) = FileName Doc 1

Thanks for your help

[ElisabtehF20]

Sub Send_email_EOMDocument()
Dim Email_Address_1 As String
Dim Subject As String
Dim Email_Address_2 As String
Dim CC As String
Dim message As String
Dim filename_1 As String
Dim filename_2 As String
Dim outlookapp As Object
Dim outlookmailitem As Object
Dim myAttachments As Object
Dim Path_1 As String
Dim Path_2 As String
Dim lastrow As Integer
Dim Attachment As String
Dim x As Integer


x = 3

Do While Sheet1.Cells(x, 1) <> ""

Set outlookapp = CreateObject("Outlook.Application")
Set outlookmailitem = outlookapp.CreateItem(0)
Set myAttachments = outlookmailitem.Attachments
Path_1 = Sheet1.Cells(x, 5)
Path_2 = Sheet1.Cells(x, 7)
Email_Address_1 = Sheet1.Cells(x, 1)
Email_Address_2 = Sheet1.Cells(x, 2)
CC = Sheet1.Cells(x, 3)
Subject = Sheet1.Cells(x, 4)
filename_1 = Sheet1.Cells(x, 6)
filename_1 = Sheet1.Cells(x, 8)
Attachment = Path + filename


outlookmailitem.To = Email_Address_1
outlookmailitem.CC = Email_Address_2
outlookmailitem.BCC = CC
outlookmailitem.Subject = Subject
outlookmailitem.Body = "Please find your end of month documents attached"


myAttachments.Add (Attachment)
outlookmailitem.Display
outlookmailitem.send

lastrow = lastrow + 1
Email_Address_1 = ""
x = x + 1

Loop


Set outlookapp = Nothing
Set outlookmailitem = Nothing


MsgBox "All the documents have been sent"

End Sub

[Mumps1]

Try this macro. It assumes that the paths in cells(x,5) and cells(x,7) include the "\" at the end and the doc names include the extension (xlsx, xlsm, xls).

Please Login or Register  to view this content.

[ElisabtehF20]

Thanks.

It doesn't work
Invalid procedure call or argument.
When I do "Debug" .Attachments.Add Path1 & Doc1 is highlighted in yellow.

Why do I have to change all my macro. I thought if I add Dim filename_2 As String and Dim Path_2 As String it will work.

[Mumps1]

As I mentioned in my previous post:

It assumes that the paths in cells(x,5) and cells(x,7) include the "\" at the end and the doc names include the extension (xlsx, xlsm, xls).

Have you checked that the paths look something like this: C:\Test\ and the doc names look something like this: MyDoc.xlsx ? I tested the macro on a dummy file and it worked properly.

[Mumps1]

I also forgot to mention that I have commented out the line to send the emails for testing purposes, so the macro will only display the emails. To send them as well, remove the apostrophe at the beginning of this line of code:

Please Login or Register  to view this content.

[ElisabtehF20]

I was a code 18 ;-( my VPN was disconnected. Thanks for your macro!! It'll help me.
But I'd also like to understand why mine doesn't work...

Sub Send_email_EOMDocument()
Dim Email_Address_1 As String
Dim Subject As String
Dim Email_Address_2 As String
Dim CC As String
Dim message As String
Dim filename_1 As String
Dim filename_2 As String
Dim outlookapp As Object
Dim outlookmailitem As Object
Dim myAttachments As Object
Dim Path_1 As String
Dim Path_2 As String
Dim lastrow As Integer
Dim Attachment_1 As String
Dim Attachment_2 As String
Dim x As Integer


x = 3

Do While Sheet1.Cells(x, 1) <> ""

Set outlookapp = CreateObject("Outlook.Application")
Set outlookmailitem = outlookapp.CreateItem(0)
Set myAttachments = outlookmailitem.Attachments
Path_1 = Sheet1.Cells(x, 5)
Path_2 = Sheet1.Cells(x, 7)
Email_Address_1 = Sheet1.Cells(x, 1)
Email_Address_2 = Sheet1.Cells(x, 2)
CC = Sheet1.Cells(x, 3)
Subject = Sheet1.Cells(x, 4)
filename_1 = Sheet1.Cells(x, 6)
filename_2 = Sheet1.Cells(x, 8)
Attachment_1 = Path_1 + filename_1
Attachment_2 = Path_2 + filename_2


outlookmailitem.To = Email_Address_1
outlookmailitem.CC = Email_Address_2
outlookmailitem.BCC = CC
outlookmailitem.Subject = Subject
outlookmailitem.Body = "Please find your end of month documents attached"


myAttachments.Add (Attachment)
outlookmailitem.Display
outlookmailitem.send

lastrow = lastrow + 1
Email_Address_1 = ""
x = x + 1

Loop


Set outlookapp = Nothing
Set outlookmailitem = Nothing


MsgBox "All the documents have been sent"

End Sub

[Mumps1]

You are very welcome. I'm not sure why your macro didn't work and it's hard to tell without seeing your original file. Perhaps you can compare the two macros to see the difference.

[ElisabtehF20]

Thanks again!!!

I want to improve myself with macro so here my file...

Have a good day!

[Mumps1]

Your macro worked for me except I couldn't test the attachments because I don't have those documents and paths. However, it seems to me that it should work for you.

[ElisabtehF20]

The error message is: Cannot add the attachment, no data source was provided

[Mumps1]

Try:

Please Login or Register  to view this content.