Hello everyone,

Can someone help me to format my e-mail body to the same as the default format of the e-mails?

I have .htmlbody because the Signature contains an image.

Also, the message is in a worksheet, but now I lost the breaks between lines of the cells.

eg:

Hello,

Regards.

Now is:

Hello, Regards.

Here's the code:

Sub Mail_single()

With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = False
        .EnableEvents = False
End With

    'avoid multiple selections
    If Selection.Count = 1 Then
    Else
    Exit Sub
    End If

Dim settings As Worksheet
Dim contacts As String
Dim master As Worksheet

Set settings = ThisWorkbook.Worksheets("settings")
contacts = ActiveSheet.Name
Set master = ThisWorkbook.Worksheets("Claim Master")

Dim nclaims As Variant
Dim disptype As Variant
Dim status As Variant
Dim supplier As Variant
Dim supname As Variant
Dim supcontact As Variant
Dim supmsg As Variant

nclaims = settings.Cells(62, 22)
disptype = settings.Cells(63, 22)
status = settings.Cells(66, 22)
supplier = settings.Cells(67, 22)
supname = settings.Cells(58, 22)
supcontact = settings.Cells(59, 22)
supmsg = settings.Cells(64, 22)

'Only for the suppliers that are to be contacted by e-mail
If Cells(ActiveCell.Row, disptype) <> "Email" Then
MsgBox ("This supplier should be contacted by " & Cells(ActiveCell.Row, disptype))
Exit Sub
Else
End If

If Cells(ActiveCell.Row, nclaims) = 0 Then
MsgBox ("Please select a supplier with pending claims")
Exit Sub
Else
End If

    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
          
    Dim sup As Range
    Set sup = Cells(ActiveCell.Row, supname)
            
    master.Activate
    Dim Claims As Workbook
    Set Claims = ThisWorkbook
    
'Create a temporary sheet with the filtered data
If ActiveSheet.AutoFilterMode Then
    ActiveSheet.AutoFilter.ShowAllData
    Else
    End If

    Cells(3, 1).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.AutoFilter
              
ActiveSheet.Range(Cells(3, 1), Cells(Cells(1, 1).End(xlDown).Rows, 20)).AutoFilter Field:=status, Criteria1:="Disputed"
ActiveSheet.Range(Cells(3, 1), Cells(Cells(1, 1).End(xlDown).Rows, 20)).AutoFilter Field:=supplier, Criteria1:=sup.Text

Sheets.Add after:=ActiveSheet
ActiveSheet.Name = "Disputed Claims"

Dim LR As Long, LC As Long
LR = master.Cells(1, 1).End(xlDown).Row
LC = master.Cells(3, 1).End(xlToRight).Column

master.Activate
ActiveSheet.Range(Cells(1, 1), Cells(LR, LC)).Copy
Sheets("Disputed Claims").Activate

Cells(1, 1).PasteSpecial xlPasteAll

master.Cells(2, 20).Copy

'Format attachment
Columns(15).ColumnWidth = 28

'Columns(2).Delete
Columns(7).Delete
Columns(9).Delete

Rows(1).Clear
Cells(1, 1) = "Pending Claims"
Cells(1, 1).Font.Size = 18
    
    Columns(1).EntireColumn.AutoFit
    Rows(1).EntireRow.AutoFit
    
    Cells(1, 2) = sup.Value
    Cells(1, 2).Font.Size = 18
    
    Rows(2).Delete
    
    Cells.EntireColumn.AutoFit
    
Cells(1, 1).Select
Application.CutCopyMode = False

'This creates the attachment
Sheets("Disputed Claims").Copy

Set Sourcewb = ActiveWorkbook
    Set Destwb = ActiveWorkbook
     
      'Determine the Excel version, and file extension and format.
    With Destwb
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                End Select
    End With
     
    Dim mysheet As Worksheet, lp As Long
  
    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Disputed Claims " & sup.Value & " " & Format(Now, "dd-mmm-yy")

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    row_number = sup.Row
    
    Dim mail_mail_body_message As String
    Dim full_name As String
    Dim contact As String
    contact = Claims.Sheets(contacts).Cells(row_number, supcontact)
    mail_body_message = Claims.Sheets(contacts).Cells(row_number, supmsg)
            
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .display
            .To = contact
            .CC = ""
            .BCC = ""
            .Subject = TempFileName
            .htmlbody = mail_body_message & .htmlbody
            .Attachments.Add Destwb.FullName
            If Claims.Worksheets(contacts).Cells(1, 11).Value = "Yes" Then
            If contact = "" Then
                MsgBox (sup.Value & " does not have assigned any contact")
                .Send
                 Else
                .Send
                End If
            Else
            .display
            End If
        End With
        On Error GoTo 0
        .Close savechanges:=False
    End With

    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    If ActiveSheet.AutoFilterMode Then
    ActiveSheet.AutoFilter.ShowAllData
    Else
    End If
    
    Application.CutCopyMode = False

master.Activate

    If ActiveSheet.AutoFilterMode Then
    ActiveSheet.AutoFilter.ShowAllData
    Else
    End If

Sheets("Disputed Claims").Delete
      
Sheets(contacts).Activate
    
ActiveSheet.Cells.EntireRow.Hidden = False
    
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
    
    If Claims.Worksheets(contacts).Cells(1, 11).Value = "Yes" Then
    MsgBox ("E-mail sent")
    Else
    End If
    
    On Error Resume Next
    OutApp.Show
        
End Sub
Thank you for your help.