Automatic email - how to change font

[Bering]

Hi,

I would need your help with this brilliant function that converts the content of a cell into HTML format.

https://social.msdn.microsoft.com/Fo...t?forum=isvvba

I have successfully integrated this function in a macro that creates an automatic email with Outlook.

The body of my email (a complex combination of text and formulae) is in a cell of my spreadsheet and the function converts it into HTML.

I have just one problem:

Once created in Outlook, the body of the email shows in a Calibri font, however I would like it to be in a different font type (Raleway).

I tried the following but, of course, nothing has worked:

1. set Raleway as default font in Outlook
2. set Raleway as font in my spreadsheet
3. tried to amend the code of the function but eventually gave up


Any ideas?

Many thanks!!

[COLOR=#333333]Function fnConvert2HTML(myCell As Range) As String    Dim bldTagOn, itlTagOn, ulnTagOn, colTagOn As Boolean[/COLOR]    Dim i, chrCount As Integer
    Dim chrCol, chrLastCol, htmlTxt As String
    
    bldTagOn = False
    itlTagOn = False
    ulnTagOn = False
    colTagOn = False
    chrCol = "NONE"
    htmlTxt = ""
    chrCount = myCell.Characters.Count
    
    For i = 1 To chrCount
        With myCell.Characters(i, 1)
            If (.Font.Color) Then
'                chrCol = fnGetCol(.Font.Color)
                If Not colTagOn Then
                    htmlTxt = htmlTxt & "[COLOR=#"]"
                End If
            Else
                chrCol = "NONE"
                If colTagOn Then
                    htmlTxt = htmlTxt & "[/COLOR]"
                    colTagOn = False
                End If
            End If
            chrLastCol = chrCol
            
            If .Font.Bold = True Then
                If Not bldTagOn Then
                    htmlTxt = htmlTxt & "[B]"
                    bldTagOn = True
                End If
            Else
                If bldTagOn Then
                    htmlTxt = htmlTxt & "[/B]"
                    bldTagOn = False
                End If
            End If
    
            If .Font.Italic = True Then
                If Not itlTagOn Then
                    htmlTxt = htmlTxt & "[I]"
                    itlTagOn = True
                End If
            Else
                If itlTagOn Then
                    htmlTxt = htmlTxt & "[/I]"
                    itlTagOn = False
                End If
            End If
    
            If .Font.Underline > 0 Then
                If Not ulnTagOn Then
                    htmlTxt = htmlTxt & "[U]"
                    ulnTagOn = True
                End If
            Else
                If ulnTagOn Then
                    htmlTxt = htmlTxt & "[/U]"
                    ulnTagOn = False
                End If
            End If
            
            If (Asc(.Text) = 10) Then
                htmlTxt = htmlTxt & "
"
            Else
                htmlTxt = htmlTxt & .Text
            End If
        End With
    Next
    
    If colTagOn Then
        htmlTxt = htmlTxt & ""
        colTagOn = False
    End If
    If bldTagOn Then
        htmlTxt = htmlTxt & ""
        bldTagOn = False
    End If
    If itlTagOn Then
        htmlTxt = htmlTxt & ""
        itlTagOn = False
    End If
    If ulnTagOn Then
        htmlTxt = htmlTxt & ""
        ulnTagOn = False
    End If
    htmlTxt = htmlTxt & ""
    fnConvert2HTML = htmlTxt [COLOR=#333333]End Function[/COLOR]