Need to know how to eliminate huge spaces between lines of text in HTMLBody

[sspatriots]

I've made some code I found online to populate the body of my e-mail without putting these huge spaces between each line of text. The code is below:

Thanks, SS

Sub create_and_email_pdf()
' Author - Philip Treacy  ::   http://www.linkedin.com/in/philiptreacy
' http://www.MyOnlineTrainingHub.com/vba-to-create-pdf-from-excel-worksheet-then-email-it-with-outlook
' Date - 14 Oct 2013
' Create a PDF from the current sheet and email it as an attachment through Outlook

Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim EmailSubject As String, sign As String
Dim Email_To As String, Email_CC As String, Email_BCC As String, Email_Body As String
Dim MsgBoxResult As Long
Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean
Dim OverwritePDF As VbMsgBoxResult
Dim OutlookApp As Object, OutlookMail As Object, msg As Object
Dim myFile As Variant
Dim result As Integer
Dim i As Integer


SaveAsPDFToG2POArchive


On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet

  
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
    strPath = Application.DefaultFilePath
End If
    strPath = strPath & "\"
    

strName = wsA.Range("K6").Value _
          & " " & wsA.Range("Q2").Value _
          & " - " & wsA.Range("D20").Value
         

'create default name for savng file
strFile = strName & ".pdf"
strPathFile = strPath & strFile


'user can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")


If Not Dir(strPath) = "" Then 'means this file was found in the specified folder
  result = MsgBox("File exists. Click yes to overwrite; No to cancel", vbYesNo + vbQuestion)
    If result = vbNo Then Exit Sub 'If yes chosen, this line is ignored and saving process should run
End If


'export to PDF if a folder was selected
If myFile <> "False" Then
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'confirmation message with file info
    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & myFile
End If
                

MsgBoxResult = MsgBox("Ready to send your PO to the Vendor?", vbYesNo + vbQuestion)
    If result = vbNo Then Exit Sub 'If yes chosen, this line is ignored and saving process should run
        If MsgBoxResult = vbNo Then
        Exit Sub
    ElseIf MsgBoxResult = vbYes Then


' *****************************************************
' *****     You Can Change These Variables    *********

    EmailSubject = "PO " & wsA.Range("K6").Value & ": " & wsA.Range("Q2").Value & ": " & wsA.Range("D20").Value & ": New Order" 'Change this to change the subject of the email. The current month is added to end of subj line"
    OpenPDFAfterCreating = False    'Change this if you want to open the PDF after creating it : TRUE or FALSE
    AlwaysOverwritePDF = False      'Change this if you always want to overwrite a PDF that already exists :TRUE or FALSE
    DisplayEmail = True 'Change this if you don't want to display the email before sending.  Note, you must have a TO email address specified for this to work
    Email_To = ""   'Change this if you want to specify To email e.g. ActiveSheet.Range("H1") to get email from cell H1
    Email_CC = ""
    Email_BCC = ""
    'Email_Body = "Please process the attached order and send the following to my attention:<BR/><BR/><li>Order acknowledgement</li><BR/><li>Any approval drawings</li><BR/><li>Estimated completion date and/or lead time after receipt of all approval data</li><BR/><li>Any questions or correspondence regarding this order</li><BR/><li>Shipping information</li><BR/><li>Tracking information<BR/><BR/>Thank you!" & sign
    
' ******************************************************


    'Create an Outlook object and new mail message
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
        
        
    OutlookMail.display
            
    sign = OutlookMail.HTMLBody
        
    'Display email and specify To, Subject, etc
    With OutlookMail
        
        .display
        .To = Email_To
        .CC = Email_CC
        .BCC = Email_BCC
        .Subject = EmailSubject '& CurrentMonth
        .Body = Email_Body
        .HTMLBody = "<p style='font-family:verdana;font-size:15'>" & "Please process the attached order and send the following to my attention:" & _
                     "<BR/><BR/><li><p style='font-family:verdana;font-size:15'>" & "Order acknowledgement</li>" & _
                     "<BR/><li><p style='font-family:verdana;font-size:15'>" & "Any approval drawings</li>" & _
                     "<BR/><li><p style='font-family:verdana;font-size:15'>" & "Estimated completion date and/or lead time after receipt of all approval data</li>" & _
                     "<BR/><li><p style='font-family:verdana;font-size:15'>" & "Any questions or correspondence regarding this order</li>" & _
                     "<BR/><li><p style='font-family:verdana;font-size:15'>" & "Shipping information</li>" & _
                     "<BR/><li><p style='font-family:verdana;font-size:15'>" & "Tracking information" & _
                     "<BR/><BR/><p style='font-family:verdana;font-size:15'>" & "Thank you!" & sign
        '.HTMLBody = Email_Body
        .Attachments.Add strFile
                
        If DisplayEmail = False Then
            
            .Send
            
        End If
        
    End With
    
    
    'do something
    Else

    'do something else
    End If
    
    
exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub

 

[sspatriots]

I forgot to add that I need an indented bullet point at the beginning of each line after the first line and before the the "Thank you!" at the end. I can probably get the bullet points in but can't indent for some reason. Thanks, Steve

 

[sspatriots]

No worries, I managed to figure it out on my own. Thanks, SS

    'Display email and specify To, Subject, etc
    With OutlookMail
        
        .display
        .To = Email_To
        .CC = Email_CC
        .BCC = Email_BCC
        .Subject = EmailSubject '& CurrentMonth
        .Body = Email_Body
        .HTMLBody = "<BODY style='font-family:Calibri;font-size:15'>" & "Please process the attached order and send the following to my attention:" & _
                    "<ul TYPE=square>" & _
                     "<BR/><BR/><li style=""Margin: 0;"">" & "Order acknowledgement</li>" & _
                     "<BR/><li style=""Margin: 0;"">Any approval drawings</li>" & _
                     "<BR/><li style=""Margin: 0;"">Estimated completion date and/or lead time after receipt of all approval data</li>" & _
                     "<BR/><li style=""Margin: 0;"">Any questions or correspondence regarding this order</li>" & _
                     "<BR/><li style=""Margin: 0;"">Shipping information</li>" & _
                     "<BR/><li style=""Margin: 0;"">Tracking information" & _
                     "</ul>" & _
                     "<BR/><BR/>" & "Thank you!" & "</BODY>" & sign
        '.HTMLBody = Email_Body
        .Attachments.Add strFile
                
        If DisplayEmail = False Then
            
            .Send
            
        End If
        
    End With