trying to get a string change the font to Calibri

[zubenubie]

Good day,

I have a peace of code and this is created from a range of cells in excel this i want to send via mail in the calibri font but i cant get it to be changed to this font.
This is the code:

 str = "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird"
    str = str & " -compose " & Chr(34) & "mailto:" & strTo & "?"
    str = str & "CC=" & Chr(34) & "mailto:" & strCC & "&"
    str = str & "subject=" & Chr(34) & strSubject & Chr(34) & "&"
    str = str & "body=" & Chr(34) & strBody & Chr(34)
    Call Shell(str, vbNormalFocus)

The strBody is the one that needs to be changed.
I have tried it in the email program but it does not change the font when it has been send to there
the cell range i selected is also Calibri

Thanks in Advance

[jdc2000]

Do you have your Thunderbird e-mail client program set to send e-mail in HTML format? If not, then font changes won't work.

[westconn1]

if you send the string body to thunderbird in correctly formatted html code that includes the font tags, it might work not that i have ever tried anything to do with thunderbird

it would also be dependent on the recipient having the font installed

[zubenubie]

Yes i have it set to send in HTML to send an i set the font to Calibri in thunderbird. but the text that is in the body stays variable width.
when i select all the text in the body and i change it to calibri it works fine. The body is a range of cells and not in html code.
I use this code to select the range:

Function rng2text(rng As Range) As String
Dim arr As Variant
Dim lngRows As Long
Dim intCols As Integer
Dim rowcount As Long
Dim colcount As Integer
Dim colsize As Variant
Dim strlen As Long

    arr = rng
    lngRows = UBound(arr, 1)
    intCols = UBound(arr, 2)
    ReDim colsize(intCols)
    For rowcount = 1 To lngRows
        For colcount = 1 To intCols
            If Len(arr(rowcount, colcount)) + 5 > colsize(colcount) Then _
            colsize(colcount) = Len(arr(rowcount, colcount)) + 5
        Next
    Next
    For rowcount = 1 To lngRows
        For colcount = 1 To intCols
            strlen = colsize(colcount) - Len(arr(rowcount, colcount))
            rng2text = rng2text & arr(rowcount, colcount) & String(strlen, Chr(2))
        Next
        rng2text = rng2text & "%0D%0A"
    Next

[westconn1]

while mailto still works, it was only designed for plain text emails
you would need to convert the excel range to an html table, including the font you want to display

something like

for each rw in myrange
  str = str & "<tr>"
  for each cel in rw
    str = str & "<td align='right'>" & cel & "</td>"   ' alignment optional
  next
  str = str & "</tr>" & vbnewline      ' the new line is not required for the html, just to make the str easier to read in vb
next

if you want different alignment or other options for your cells it might be better not to loop all the cells in the row, but jusy use a single line

str = str & "<tr><td>" & Text1(i) & "<td>" & Text3(i) & "<td align='right'>" & lprice & "</tr>" & vbNewLine

(copied from existing code) change the text boxes to the appropriate cells

also you probably need html header tags as well as font tags
none of the above is tested, just typed in the browser to give you the idea

[zubenubie]

allright but i do not know where to put this code,
This is the full code:

Sub tbSendMAster2()
ActiveWorkbook.Worksheets("SeaSend").Unprotect Password:="Oliedom43"
 Dim dteDate As Date
     Dim txtDate As String
    
    dteDate = Now()
    
    txtDate = CStr(dteDate)
   txtDate = Format(txtDate, "dd-mm-yyyy")
  


    TB_MailSend "lala@lala.com", "lalala@lalalal.nl", "MV blabla" & "Voy. " _
    & ActiveWorkbook.Worksheets("SeaSend").Range("E4") & " Sea report " _
     & " " & txtDate, _
     " " & rng2text(ActiveWorkbook.Worksheets("SeaSend").Range("A1:F23"))
     
ActiveWorkbook.Worksheets("SeaSend").Protect Password:="Oliedom43"

End Sub

Public Function TB_MailSend(strTo As String, strCC As String, strSubject As String, strBody As String)
Dim str As String

'TB_MailSend "fred@fred.com", "my Subject", "My Body"
    str = "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird"
    str = str & " -compose " & Chr(34) & "mailto:" & strTo & "?"
    str = str & "CC=" & Chr(34) & "mailto:" & strCC & "&"
    str = str & "subject=" & Chr(34) & strSubject & Chr(34) & "&"
    str = str & "body=" & Chr(34) & strBody & Chr(34)
    Call Shell(str, vbNormalFocus)

End Function

Function rng2text(rng As Range) As String
Dim arr As Variant
Dim lngRows As Long
Dim intCols As Integer
Dim rowcount As Long
Dim colcount As Integer
Dim colsize As Variant
Dim strlen As Long

    arr = rng
    lngRows = UBound(arr, 1)
    intCols = UBound(arr, 2)
    ReDim colsize(intCols)
    For rowcount = 1 To lngRows
        For colcount = 1 To intCols
            If Len(arr(rowcount, colcount)) + 5 > colsize(colcount) Then _
            colsize(colcount) = Len(arr(rowcount, colcount)) + 5
        Next
    Next
    For rowcount = 1 To lngRows
        For colcount = 1 To intCols
            strlen = colsize(colcount) - Len(arr(rowcount, colcount))
            rng2text = rng2text & arr(rowcount, colcount) & String(strlen, Chr(2))
        Next
        rng2text = rng2text & "%0D%0A"
    Next
    
End Function

Thank you for your help

[westconn1]

where to put this code,

it would replace your existing rng2text, i would try a new function rng2html, then no need to change any of the existing code

TB_MailSend "lala@lala.com", "lalala@lalalal.nl", "MV blabla" & "Voy. " _
& ActiveWorkbook.Worksheets("SeaSend").Range("E4") & " Sea report " _
& " " & txtDate, _
" " & rng2text(ActiveWorkbook.Worksheets("SeaSend").Range("A1:F23"))

you can try a simplified version first to see if it works at all

[zubenubie]

Thanks for the pointer, i copied you code into a new function but i am getting nothing in the body of the message

Function rng2html(rng As Range) As String

Dim str As String

For Each Rw In rng
  str = str & "<tr>"
  For Each cell In Rw
    str = str & "<td align='Left'>" & cell & "</td>"   ' alignment optional
  Next
  str = str & "</tr>" & vbNewLine      ' the new line is not required for the html, just to make the str easier to read in vb
Next


End Function

[westconn1]

you would need to assign the string to the return of the function, just before end function

rng2html = str

[zubenubie]

Thanks the body does show but now i see al the rows and cells with all the HTML tags
like this
<tr><td align='right'>Good day,</td></tr><tr><td align='right'></td></tr><tr><td align='right'></td></tr><tr><td align='right'></td></tr><tr><td align='right'></td></tr><tr><td align='right'></td></tr><tr><td align='right'>Please find below:</td></tr><tr><td align='right'></td></tr><tr><td align='right'></td></tr><tr><td align='right'></td></tr><tr><td align='right'></td></tr><tr><td

[westconn1]

Thanks the body does show but now i see al the rows and cells with all the HTML tags

in that case it would appear that the email is sent in plain text only and no changes can be made using the mailto method

you should consider some alternative method of sending emails