Excel VBA: Keep .OFT formatting when replacing data

[DanL]

Hi, Folks.
I'm working on a VBA routine where I want to open an Outlook template (with formatting) and replace data from data in the spreadsheet.

I'm using Office 2021: Excel 2021 and Outlook 2021 connecting to an Exchange 365 server (GoDaddy).

I am able to open the template. When I Outlook.Display the message, it displays with the formatted text. Alas! When I try to replace ANYTHING in the body of the email with OutMail.body = Replace(OutMail.body, "<<RECIPIENT>>", var) , the template format reverts (converts? Changes?) to text. Replacing text in the TO:, SUBJECT:, CC:, or BCC: fields keeps the formatting. The data is getting to the template.

The relevant code is below. Any ideas on what I'm doing wrong?

Dim OutApp As Object
Dim OutMail As Object
Dim eBody As String
Dim CurrentRow As Integer

'Variables for tags in the template
Dim eMailTag, eContactTag, eAddressTag, eDescriptionTag, eValueTag As String

' Set the workbook and worksheet you want to send
' Create a new Outlook instance
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0) ' 0 represents a mail item
Set myolapp = CreateObject("Outlook.Application")
myolapp.Session.Logon
'This is where the OFT template lives. It must be explicitly declared.
Set OutMail = OutApp.CreateItemFromTemplate("C:\Users\xxx\Sales\Systems\Proposal_10.oft")

OutMail.display 'or send
OutMail.HTMLBody = OutMail.HTMLBody 'does not work with or without this line.
' Get the data from the spreadsheet and assign the cels to the tag variables
MsgBox ("check the email...")
Sheets("Pipeline").Select
With ActiveSheets
eMailTag = ActiveSheet.Cells(ActiveCell.Row, 8)
eContactTag = ActiveSheet.Cells(ActiveCell.Row, 6)
eAddressTag = ActiveSheet.Cells(ActiveCell.Row, 4)
eDescriptionTag = ActiveSheet.Cells(ActiveCell.Row, 5)

eValueTag = ActiveSheet.Cells(ActiveCell.Row, 14)
'if you add more tags, the assignments go here.
End With

' Replace the data in the template
With OutMail
.bodyformat = olFormatRichText
OutMail.To = eMailTag 'Still formatted here.

OutMail.Subject = "Proposal: " & eDescriptionTag 'Still formatted here...
.body = Replace(.body, "<<EMAIL>>", eMailTag)

OutMail.body = Replace(OutMail.body, "<<RECIPIENT>>", eContactTag)
OutMail.body = Replace(OutMail.body, "<<ADDRESS>>", eAddressTag)
OutMail.body = Replace(OutMail.body, "<<DESCRIPTION>>", eDescriptionTag)
OutMail.body = Replace(OutMail.body, "<<VALUE>>", eValueTag)
End With

' MsgBox (OutMail.body)
' OutMail.display 'or send

' Clean up
Set OutMail = Nothing
Set OutApp = Nothing

End Sub

 

[DanL]

Additional data: <<RECIPIENT>>, <<ADDRESS>>, etc. is text in the template I'd like to replace.

 

[JoePublic]

Is there a reason for changing the format to rich text? Normally, if it's an HTML email, you'd just replace the text in the HTMLBody property, not the Body one.