NewMsg.BodyFormat = olFormatHTML
NewMsg.save

NewMsg.BodyFormat = olFormatRichText
NewMsg.save
NewMsg.BodyFormat = olFormatHTML
NewMsg.save

Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    ' default local Inbox
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)
  On Error GoTo ErrorHandler
    Dim Msg As Outlook.MailItem
    Dim NewMsg As Outlook.MailItem

    If TypeName(item) = "MailItem" Then

        Set Msg = item

        If Msg.SenderEmailAddress <> "example@example.com" Then GoTo Skip

        If InStr(1, Msg.Subject, "Specific String") > 0 Then

        Set NewMsg = Application.CreateItemFromTemplate("Template Path")

        Msg.Subject = Replace(Msg.Subject, "Give message new subject", "New subject")
        Msg.Save

        'NewMsg.BodyFormat = olFormatRichText
        'NewMsg.save
        'NewMsg.BodyFormat = olFormatHTML
        'NewMsg.save

        NewMsg.Attachments.Add Msg

        NewMsg.Recipients.Add("Example@Example.com")
        NewMsg.Subject = Msg.Subject

        'NewMsg.Display
        NewMsg.Send

    End If

  End If

Skip:
ProgramExit:

  Exit Sub
ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description

End Sub