Attachments Embedded in the email Body

[abc_xyz]

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

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