• 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

    Hui...

  • 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

hsm123

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?

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

shs.Activate
shs.Calculate

    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
           .display
       End With
 
 
       Set OutApp = Nothing
 
   End If
 
Next shs



Sheets("Dashboard").Activate

Application.ScreenUpdating = True


End Sub
 
hsm123
You should reread Forum Rules
There are clear sentences if someone uses Cross-Posting.
Ps. Same kind of rules are everywhere.
 
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.

Greetings,
Peter
 
Back
Top