HTML in VBA - unable to format cell as number/currency

Question

I am trying to paste a table from excel to outlook using an HTML body but I cant seem to get the number format right. The excel sheet has negative numbers as red however when transferred to outlook, they're all black. The following is part of the 'convert to HTML code' I am using, not sure why the mso number format isnt getting picked

            If rCell.Column = 1 Then
                strReturn = strReturn & "<td valign='Center' style='border:solid windowtext 1.0pt; padding:0cm 5.4pt 0cm 5.4pt;height:1.05pt'><b>" & rCell.Text & "</b></td>"
            Else
               strReturn = strReturn & "<td valign='Center' style='border:solid windowtext 1.0pt; padding:0cm 5.4pt 0cm 5.4pt;height:1.05pt;mso-number-format:\#\,\#\#0\.00_ \;\[Red\]\-\#\,\#\#0\.00\'>" & rCell.Text & "</td>"
            End If

The full code for the function is below -

Public Function ConvertRangeToHTMLTable(rInput As Range) As String

Dim rRow As Range
Dim rCell As Range
Dim strReturn As String

strReturn = "<table border='1' cellspacing='0' cellpadding='7' style='border-collapse:collapse;border:none;width:650px'>"

For Each rRow In rInput.Rows

    strReturn = strReturn & " <tr align='Left'; style='height:10.00pt'> "
    For Each rCell In rRow.Cells

        If rCell.row = 1 Then
            strReturn = strReturn & "<td valign='Center' style='border:solid windowtext 1.0pt; padding:0cm 5.4pt 0cm 5.4pt;height:1.05pt; background-color: rgb(180, 198, 231)'><b>" & rCell.Text & "</b></td>"
        ElseIf rCell.row = 11 Then
            strReturn = strReturn & "<td valign='Center' style='border:solid windowtext 1.0pt; padding:0cm 5.4pt 0cm 5.4pt;height:1.05pt; background-color: rgb(180, 198, 231)'><b>" & rCell.Text & "</b></td>"
        Else
            If rCell.Column = 1 Then
                strReturn = strReturn & "<td valign='Center' style='border:solid windowtext 1.0pt; padding:0cm 5.4pt 0cm 5.4pt;height:1.05pt'><b>" & rCell.Text & "</b></td>"
            Else
               strReturn = strReturn & "<td valign='Center' style='border:solid windowtext 1.0pt; padding:0cm 5.4pt 0cm 5.4pt;height:1.05pt;mso-number-format:\#\,\#\#0\.00_ \;\[Red\]\-\#\,\#\#0\.00\'>" & rCell.Text & "</td>"
            End If
        End If
    Next rCell
    
    
    strReturn = strReturn & "</tr>"
Next rRow

strReturn = strReturn & "</font></table>"

ConvertRangeToHTMLTable = strReturn

End Function

Answer 1

I use the following function (modified from the Ron de Bruin similar function) to allow conditional formatting, etc., remain:

Private Function CopyRangeToHTML(ByVal n As Range)
    Dim fso As Object, ts As Object, temp As String
    Dim wbs As Workbook: Set wbs = n.Worksheet.Parent
    temp = Environ$("temp") & "/" & Format(Now, "yyyyMMddHHmmss") & ".htm"
    With wbs.PublishObjects.Add(SourceType:=xlSourceRange, Filename:=temp, Sheet:=n.Worksheet.Name, Source:=n.Address, HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(temp).OpenAsTextStream(1, -2)
    CopyRangeToHTML = ts.ReadAll
    ts.Close
    Kill temp
    Set ts = Nothing
    Set fso = Nothing
    Set wbs = Nothing
End Function

You can then use the above function via HTMLBody , such as:

.HTMLBody = .HTMLBody & CopyRangeToHTML(tableRangeRef)