Add multiple attachments within Outlook Body

[Harshil Mehta]

I am working on a file wherein I have to add multiple attachments within the Outlook mail body using the RICH TEXT function.

Below is the desired output:

Start of the email text

Part 1 Text
FILE 1 & FILE2

Part 2 Text
FILE 1 & FILE2

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

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

 

[RoryA]

Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Multiple attachments in email body
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.