VBA HTML Body Font Size and Blank Lines

[Ruca13]

Hello Everyone,

I have a macro to create an email with pdf attachments and text in the email body.

While the macro works, in the email itself I have two situations that I cannot tackle: the font size of my email does not match the one I indicate; I have two blank lines between the email body and the email signature.

I have tried to replace the variable of the font size, but it seems it only goes wrong for the size 11 (which I chose). If I try it with 10.5 or 11.5, it formats for the expected size. Just not if the size is 11...

About the blank lines, I only wish to have one. If I create a new email, these are already there. In case it is relevant, the email signature is an image.

Please see below the code:

Option Explicit
Sub invoice_approval()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.DisplayAlerts = False

Dim master As Workbook
Dim lookups As Variant
Dim settings As Worksheet
Dim infomail As Variant
Dim mllastrow As Variant
Dim invoicepath As Variant
Dim invoicepdf As Variant
Dim invoicenumber As Variant
Dim invapproval As Variant
Dim mlpath As String
Dim NewBook As Workbook
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim i As Integer
Dim n As Variant
Dim c As Integer
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim mail_body_message As String
Dim invoice_body_message As String
Dim supplier As Variant
Dim invnumber As Variant
Dim regn As Variant
Dim icao As Variant
Dim uplfdate As Variant
Dim mlrange As Range
Dim invmlrange As Range
Dim mailfontname As String
Dim mailfontsize As String
Dim mailfontcolor As String
Dim cell As Range

Set master = ThisWorkbook
Set lookups = master.Worksheets("Lookups")
Set settings = master.Worksheets("Settings")
invoicenumber = settings.Cells(18, 24)
mlpath = Application.ThisWorkbook.Path
infomail = settings.Cells(4, 19)
supplier = settings.Cells(11, 24)
invnumber = settings.Cells(18, 24)
regn = settings.Cells(6, 24)
icao = settings.Cells(15, 24)
uplfdate = settings.Cells(17, 24)
mailfontname = settings.Cells(9, 15).Value
mailfontsize = settings.Cells(10, 15).Value
mailfontcolor = settings.Cells(11, 15).Value
   
    If ActiveSheet.AutoFilterMode Then
    ActiveSheet.AutoFilter.ShowAllData
    Else
    End If
   
    mllastrow = Cells(2, 1).End(xlDown).Row
    Set mlrange = Range(Cells(3, 1), Cells(mllastrow, Cells(2, 1).End(xlToRight).Column))
    Set invmlrange = Range(Cells(3, invnumber), Cells(mllastrow, invnumber))
   
lookups.Cells(1, 24).FormulaR1C1 = "=TODAY()"

invoicepath = mlpath & "\" & Worksheets("Lookups").Cells(1, 28).Value & "\xxx"
invoicepdf = Dir(invoicepath & "/*.pdf")
Application.Calculation = xlCalculationAutomatic
  
    Set NewBook = Workbooks.Add
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(invoicepath)
    For Each oFile In oFolder.Files
    Cells(i + 1, 1) = oFile.Name
    i = i + 1
    Next oFile

    On Error GoTo noattachmentserror:
    n = Worksheets("Sheet1").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).count
    
noattachmentserror:
    If n = 0 Then
        NewBook.Close savechanges:=False
        master.Activate
            If ActiveSheet.AutoFilterMode Then
            ActiveSheet.AutoFilter.ShowAllData
            Else
            End If
        MsgBox "No Invoices to Attach"
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
        Application.EnableEvents = True
        Application.DisplayAlerts = True
        Exit Sub
    Else
    End If
   
    Dim arr As Variant
    Cells(1, 2).FormulaR1C1 = "=LEFT(RC[-1],LEN(RC[-1])-4)"
    If n > 1 Then
    Cells(1, 2).Select
    Selection.AutoFill destination:=Range(Cells(1, 2), Cells(n, 2))
    arr = Application.Transpose(Range(Cells(1, 2), Cells(n, 2)).Value)
    Else
    arr = Cells(1, 2).Value
    End If

Application.Calculation = xlCalculationManual
master.Worksheets(1).Activate
   
    ActiveSheet.Range(Cells(2, 1), Cells(Cells(2, 1).End(xlDown).Row, Cells(2, 1).End(xlToRight).Column)).AutoFilter Field:=invoicenumber, Criteria1:= _
        arr, operator:=xlFilterValues

    For Each cell In invmlrange.SpecialCells(xlCellTypeVisible)
    invoice_body_message = Cells(cell.Row, supplier) & " Invoice attached:" & "<BR>" _
    & Cells(cell.Row, invnumber) & " - " & Cells(cell.Row, regn) & " " & _
    Cells(cell.Row, icao) & " " & Day(Cells(cell.Row, uplfdate)) & MonthName(Month(Cells(cell.Row, uplfdate)), True) _
    & "; OK to pay" & "<BR>" & "<BR>" & invoice_body_message
    Next cell

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    mail_body_message = "Dear Team," & "<BR>" & "<BR>" & invoice_body_message
   
    On Error Resume Next
    With OutMail
            Set .SendUsingAccount = OutApp.Session.Accounts.Item(infomail)
            .Display
            .To = "test@test.com"
            .CC = ""
            .BCC = ""
           
            invoicepath = mlpath & "\" & Worksheets("Lookups").Cells(1, 28).Value & "\xxx/"
            invoicepdf = Dir(invoicepath & "*.pdf")
           
            Do
            .attachments.Add invoicepath & invoicepdf
            invoicepdf = Dir()
            Loop Until Len(invoicepdf) = 0
           
            .Subject = "Subject"
            .htmlbody = "<p style='font-family:" & mailfontname & ";color:" & mailfontcolor & ";font-size:" & mailfontsize & "pt'>" & mail_body_message & .htmlbody
                .Display
             '   .Send
        End With
    Set OutMail = Nothing
    Set OutApp = Nothing
   
    NewBook.Close savechanges:=False

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.DisplayAlerts = True

End Sub

Thank you for your help.