Blank Lines in Email Body

[Ruca13]

Hello all,

I have a code to generate a outlook email based on cells.

I can generate the email fine but for some reason I have two blank lines between the email body text and my signature.

Another slight problem is the font size. When I define to 11, it shows as 10. I tried to change to 12 and to 10, and in both situations it is okay, the only problem seems to be when the font size is 11.

Here is the code:

Option Explicit


Sub tailwinsemail()


    Application.ScreenUpdating = False
    'Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    Dim emailsheet As Worksheet
    Dim tailwinslist As Worksheet
    Dim reference As Variant
    Dim emailref As Variant
    Dim emailcontact As Variant
    Dim emailsubject As Variant
    Dim emailbody As Variant
    Dim OutApp As Object
    Dim OutMail As Object
    Dim mailfontname As String
    Dim mailfontsize As String
    Dim mailfontcolor As String
    
    Set emailsheet = ThisWorkbook.Worksheets("Tailwins Email")
    Set tailwinslist = ThisWorkbook.Worksheets("Tailwins List")
    
    Set reference = Cells(ActiveCell.Row, 2)
    
    mailfontname = emailsheet.Cells(11, 7)
    mailfontsize = emailsheet.Cells(12, 7)
    mailfontcolor = emailsheet.Cells(13, 7)
    
    emailsheet.Cells(2, 7) = "'" & reference.Value
    
    Set emailref = emailsheet.Cells(2, 7)
    
    emailcontact = emailsheet.Cells(1, 3)
    emailsubject = emailsheet.Cells(3, 3)
    emailbody = emailsheet.Cells(5, 3) & "
" & "
" & emailsheet.Cells(6, 3) & "
" & "
" & _
    emailsheet.Cells(7, 3)
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    With OutMail
    Set .SendUsingAccount = OutApp.Session.Accounts.Item("helpdesk@essentialjetsolutions.com")
        .Display
        .To = emailcontact
        .CC = ""
        .BCC = ""
        .Subject = emailsubject
        .htmlbody = "[COLOR=&quot][FONT=&quot]" & emailbody & .htmlbody
        .Display
    End With


    Set OutMail = Nothing
    Set OutApp = Nothing
    
    Application.ScreenUpdating = True
    'Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.DisplayAlerts = True


End Sub

Thank you for your help.

Regards,
Rui[/FONT][/COLOR]