• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User


  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Multiple attachments in email body


New Member
Below is the desired output:

Start of the email text

Part 1 Text
Attachment1 & Attachment2

Part 2 Text
Attachment1 & Attachment2

End of email text

However, my code seems to add the attachment files only after the Part2 Text. Could anyone please help me with the code?

Sub Prepare_Drafts()
Dim OutApp As Object
Dim Default_Body As String
Dim shs As Worksheet
Dim File_Name As String
Dim p1 As Long, p2 As Long, p3 As Long

Application.ScreenUpdating = False

For Each shs In Sheets


    If shs.Name <> "Dashboard" Then
       On Error Resume Next
       Set OutApp = GetObject(, "Outlook.Application")
       File_Name = shs.Range("D5").Value
 Default_Body = "Start of email text." & vbCr & vbCr & _
"Part 1 Text" & vbCr & _
"*FILE1*" & "*FILE2*" & vbCr & vbCr & _
"Part 2 Text" & vbCr & _
"*FILE1*" & "*FILE2*" & vbCr & vbCr & _
"End of email text."
    p1 = InStr(Default_Body, "*FILE1*")
    Default_Body = Replace(Default_Body, "*FILE1*", " ")
    p2 = InStr(Default_Body, "*FILE2*")
    Default_Body = Replace(Default_Body, "*FILE2*", " ")
       With OutApp.CreateItem(0)
           .BodyFormat = 3
           .To = shs.Range("D7").Value
           .CC = shs.Range("D11").Value
           .BCC = ""
           .Subject = shs.Range("D17").Value
           .Body = Default_Body
           .Attachments.Add "C:\Users\" & ThisWorkbook.Sheets("Dashboard").Range("E5") & "\Desktop\Jan.pdf" ', olByValue, p1, "file1"
           .Attachments.Add "C:\Users\" & ThisWorkbook.Sheets("Dashboard").Range("E5") & "\Desktop\Feb.pdf" ', olByValue, p2, "file2"
           '.SaveAs "C:\Users\" & ThisWorkbook.Sheets("Dashboard").Range("E5") & "\Desktop\" & File_Name ', olTemplate
       End With
       Set OutApp = Nothing
   End If
Next shs


Application.ScreenUpdating = True

End Sub


Excel Ninja
You should reread Forum Rules
There are clear sentences if someone uses Cross-Posting.
Ps. Same kind of rules are everywhere.


New Member
Send multiple attachments to each recipient
Open the Google spreadsheet for the mail merge.
In Google Sheets, select Add-ons > Yet Another Mail Merge > Start Mail Merge.
Click + Alias, filters, personalized attachments.
Select Attach files in column “...” to emails sent, and click Back.
Click Send emails.