Editing an Email Macro for font/size/etc

[RBewley]

I'm using a Macro I found on this forum (Difficult problem with e-mail macro PLEASE HELP! - Tech Support Guy Forums -response from Zach Barresse) to send outlook emails from excel. I edited the macro to fit my needs but I'm having difficulty changing the font, color, size, etc. of different parts of the email. I've found lots of posts that describe how to change formats. The problem is that I can't figure out how to incorporate those codes into my macro.

The "strHeader" in the macro currently looks like this:strHeader = "Good Morning," & DNL & "<insert Paragraph1="">" & strEmail3 & " <insert Paragraph2="">" & DNL & "<insert Paragraph3="">" & NL</insert></insert></insert>

I want to edit the macro so that:
"Good Morning" is Bold, size 22,
"<insert Paragraph1="">" </insert>is Italicized, red, and centered, and
strEmail3 = is underlined.

-------------------------------------------------------------------------------------------------------------
Here's the code:

Option Explicit
Sub EmailPayments()

'References set to (Tools | References..):
'Microsoft Outlook xx.0 Object Library*
'Microsoft Scripting Runtime
'* Substitute xx for your version. 12=2007, 11=2003, 10=2002 (XP), 9=2000, etc

'Declare variables
Dim olApp As Outlook.Application, olMail As Outlook.MailItem
Dim dic As Scripting.Dictionary
Dim wb As Workbook, ws As Worksheet
Dim c As Range, rngWhole As Range, rngLook As Range, rngFilter As Range
Dim strBody As String, strHeader As String, strFooter As String
Dim strEmail As String, strEmail2 As String, strEmail3 As String
Dim lastRow As Long, i As Long, dblTotal As String
Dim blnCreated As Boolean

'Set variables
Set wb = ThisWorkbook
Set ws = wb.Sheets(1) '** CUSTOMIZE IF NECESSARY **
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Set rngWhole = ws.Range("A1:K" & lastRow)
Set rngLook = ws.Range("A2:K" & lastRow)
Set dic = CreateObject("Scripting.Dictionary")
Const NL As String = vbNewLine
Const DNL As String = vbNewLine & vbNewLine

'Trim up application features for efficiency
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

'Check if Outlook is already open or not
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
Err.Clear
blnCreated = True
Else
blnCreated = False
End If
On Error GoTo 0

'Iterate through data structure
For i = 2 To lastRow
'Set value to dictionary, check if unique
If dic.Exists(ws.Cells(i, 2).Value) = False Then
dic.Add ws.Cells(i, 2).Value, ws.Cells(i, 2).Value
strEmail = ws.Cells(i, 9).Value
strEmail2 = ws.Cells(i, 10).Value
strEmail3 = ws.Cells(i, 2).Value
ws.AutoFilterMode = False
rngWhole.AutoFilter 2, ws.Cells(i, 2).Value
Set rngFilter = ws.Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible)
If Not rngFilter Is Nothing Then
'Check Contact info..
Select Case ws.Cells(rngFilter(1, 1).Row, 8).Value
Case "CONFIRM VIA WEBSITE", "DO NOT CONFIRM" '** CUSTOMIZE IF NECESSARY **
GoTo SkipEmail
End Select
'Loop through available cells, create body
For Each c In rngFilter '** CUSTOMIZE IF NECESSARY **
strBody = strBody & "Invoice: " & c.Value & NL
strBody = strBody & "Attribute1: " & c.Offset(0, 2).Value & NL
strBody = strBody & "Attribute2: " & c.Offset(0, 3).Value & NL
strBody = strBody & "Attribute3 " & c.Offset(0, 4).Value & "%" & DNL

Next c
'Set email up nomenclature
Set olMail = olApp.CreateItem(olMailItem)
olMail.To = strEmail
olMail.CC = strEmail2
olMail.Subject = "SUBJECT CUSTOMIZEZ (" & strEmail3 & ")" '** CUSTOMIZE IF NECESSARY **
strHeader = "Good Morning," & DNL & "<insert Paragraphs="">" & strEmail3 & " <insert Paragraphs="">" & DNL & "<insert Paragraphs="">" & NL</insert></insert></insert>
strFooter = "Thank you, " & DNL & "Name" & NL & "Title" & NL & "Address" & NL & "Telephone"
strBody = NL & strBody
olMail.Body = strHeader & strBody & strFooter
strBody = ""
olMail.Display
SkipEmail:
Set rngFilter = Nothing
End If
End If
Next i

'Quit Outlook if programmatically created
If blnCreated = True Then
olApp.Quit
End If
'Reset application to a default state
ws.AutoFilterMode = False
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub