.CreateItemFromTemplate with VBA excel but text format not

[tendosai]

Greeting everyone.

I am trying to make Mail Merge with Excel + Outlook by using mail template i created. In template i have all text and text format with [FirstName] to get the name from excel column. Everything work fine except that the text format (font style, color, bold etc) all goes to default setting like you compose a new mail. your guidance is very much appreciate. Here is the code for VBA in excel:

Public Sub SendMailMergeExcel()

Dim olApp As Object
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim rCount As Long
Dim bXStarted As Boolean
Dim enviro As String
Dim appdata As String
Dim strPath As String
Dim strAttachPath As String
Dim SendTo As String
Dim CCTo As String
Dim strABM As String
Dim strABMPhone As String
Dim AcctMgrEmail


Dim olItem As Outlook.MailItem
Dim Recip As Outlook.Recipient


' Get Excel set up
enviro = CStr(Environ("USERPROFILE"))
appdata = CStr(Environ("appdata"))
On Error Resume Next
Set xlApp = Excel.Application
On Error GoTo 0
'Open the workbook to input the data
Set xlWB = xlApp.ActiveWorkbook
Set xlSheet = xlWB.Sheets("Sheet1")
' Process the message record


On Error Resume Next


rCount = 2
strAttachPath = enviro & "\Documents\Send\"
Set olApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set olApp = CreateObject("Outlook.Application")
bXStarted = True
End If


Do Until Trim(xlSheet.Range("A" & rCount)) = ""


strFirstname = xlSheet.Range("A" & rCount)
SendTo = xlSheet.Range("B" & rCount)
CCTo = xlSheet.Range("C" & rCount)
strSubject = xlSheet.Range("D" & rCount)
' if adding attachment
'strAttachment = strAttachPath & xlSheet.Range("E" & rCount)
strABM = xlSheet.Range("F" & rCount)
strABMPhone = xlSheet.Range("G" & rCount)


'Create Mail Item and view before sending
' Default message form
'Set olItem = olApp.CreateItem(olMailItem)


' use a Template
Set olItem = olApp.CreateItemFromTemplate(appdata & "\Microsoft\Templates\FP Mail.oft")


With olItem
.SentOnBehalfOfName = AcctMgrEmail
.To = SendTo
.CC = CCTo
.Subject = strSubject


.Body = Replace(.Body, "[FirstName]", strFirstname)
.Body = Replace(.Body, "[ABM]", strABM)
.Body = Replace(.Body, "[ABMPhone]", strABMPhone)
'if adding attachments:
'.Attachments.Add strAttachment
'.Save


.Display
'.Send
End With


rCount = rCount + 1


Loop


Set xlWB = Nothing
Set xlApp = Nothing



End Sub

(Code is not mine. I only edit some part due to error))

[gmayor]

Change the following lines from


.Body = Replace(.Body, "[FirstName]", strFirstname)
.Body = Replace(.Body, "[ABM]", strABM)
.Body = Replace(.Body, "[ABMPhone]", strABMPhone)


to


.BodyFormat = 2
.HTMLBody = Replace(.HTMLBody, "[FirstName]", strFirstname)
.HTMLBody = Replace(.HTMLBody, "[ABM]", strABM)
.HTMLBody = Replace(.HTMLBody, "[ABMPhone]", strABMPhone)

[tendosai]

Change the following lines from


.Body = Replace(.Body, "[FirstName]", strFirstname)
.Body = Replace(.Body, "[ABM]", strABM)
.Body = Replace(.Body, "[ABMPhone]", strABMPhone)


to


.BodyFormat = 2
.HTMLBody = Replace(.HTMLBody, "[FirstName]", strFirstname)
.HTMLBody = Replace(.HTMLBody, "[ABM]", strABM)
.HTMLBody = Replace(.HTMLBody, "[ABMPhone]", strABMPhone)

Ah problem solve. I have tried with HTML body but didnt know i have to put .BodyFormat = 2.

Thank so much.