Hello,
I use the below brilliant function (which I found somewhere on the internet) to convert to HTML the content of a cell (H9) in order to use it in the body of automatic emails and it works great. This is very helpful, because the body of my email is quite complex, with a lot of concatenations of strings and variables.
The only thing I am not happy with is that email gets always created in a Calibri font, even though the default one in Outlook is "Raleway".
I do not know how I could change the below code to achieve this...
Any ideas?
Thanks.
I use the below brilliant function (which I found somewhere on the internet) to convert to HTML the content of a cell (H9) in order to use it in the body of automatic emails and it works great. This is very helpful, because the body of my email is quite complex, with a lot of concatenations of strings and variables.
The only thing I am not happy with is that email gets always created in a Calibri font, even though the default one in Outlook is "Raleway".
I do not know how I could change the below code to achieve this...
Any ideas?
Thanks.
VBA Code:
ActiveSheet.Range("H9") = "=fnConvert2HTML(RC[-1])"
strBody = ActiveSheet.Range("H9")
'COMBINE THE EMAIL WITH THE SIGNATURE
.HTMLBody = strBody & strSig
VBA Code:
Function fnConvert2HTML(myCell As Range) As String
Dim bldTagOn, itlTagOn, ulnTagOn, colTagOn As Boolean
Dim i, chrCount As Integer
Dim chrCol, chrLastCol, htmlTxt As String
bldTagOn = False
itlTagOn = False
ulnTagOn = False
colTagOn = False
chrCol = "NONE"
htmlTxt = "<html>"
chrCount = myCell.Characters.Count
For i = 1 To chrCount
With myCell.Characters(i, 1)
If (.Font.Color) Then
If Not colTagOn Then
htmlTxt = htmlTxt & "<font color=#" & chrCol & ">"
colTagOn = True
Else
If chrCol <> chrLastCol Then htmlTxt = htmlTxt & "</font><font color=#" & chrCol & ">"
End If
Else
chrCol = "NONE"
If colTagOn Then
htmlTxt = htmlTxt & "</font>"
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 & "<br>"
Else
htmlTxt = htmlTxt & .Text
End If
End With
Next
If colTagOn Then
htmlTxt = htmlTxt & "</font>"
colTagOn = False
End If
If bldTagOn Then
htmlTxt = htmlTxt & "</b>"
bldTagOn = False
End If
If itlTagOn Then
htmlTxt = htmlTxt & "</i>"
itlTagOn = False
End If
If ulnTagOn Then
htmlTxt = htmlTxt & "</u>"
ulnTagOn = False
End If
htmlTxt = htmlTxt & "</html>"
fnConvert2HTML = htmlTxt
End Function
