Удалите лишние пустые строки из шаблона генерации кода VBA

Question

У меня есть шаблон электронной почты и некоторый код, который генерирует электронные письма. В шаблоне письма у меня есть следующее:

Комментарии:

• Comment1
• Comment2
• Comment3
• Comment4
• Comment5

Код использует функцию замены для замены comment1 из ячейки Excel. В Excel Comment1 находится в ячейке B2, Comment2 находится в ячейке C2, Comment3 находится в ячейке d2 и т. Д. Не все комментарии могут понадобиться для электронной почты. Если ячейка пуста, я хочу удалить строку в письме. Текущее электронное письмо оставляет огромное пространство из 3-4 лишних пустых строк, потому что нет комментариев. Полный код ниже:

Sub SendEmail()
Dim rRng As Range
Dim OutApp As Object, OutMail As Object
Dim StrBody1 As String, StrBody2 As String, StrBody3 As String, StrBody4 As String, StrBody5 As String       
StrBody1 = "<font size=""3.5"" face=""Arial"" color=""86BC25"">" & _
            "<b>Comments:</b>" & "<br>" & _
            sComment1

StrBody2 = "<font size=""3.5"" face=""Arial"" color=""black"">" & _
            sComment2

StrBody3 = "<font size=""3.5"" face=""Arial"" color=""black"">" & _
            sComment3

StrBody4 = "<font size=""3.5"" face=""Arial"" color=""black"">" & _
            sComment4

StrBody5 = "<font size=""3.5"" face=""Arial"" color=""black"">" & _
            sComment5


'rRng refers to graph copied into email
    Set rRng = Nothing
    With Sheet1    ''///Summary sheet
        Set rRng = .Range(.Cells(10, 5), .Cells(11, 11))
    End With

    On Error GoTo clean_up

    With Application
        .EnableEvents = False
        .ScreenUpdating = False


        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItemFromTemplate("Myfilelocation")

       On Error Resume Next
       With OutMail
          .To = sTo
         .CC = sCC
        .Subject = sSubj

        'The code below searches for the word in the email template and uses the replace function
        .htmlbody = Replace(.htmlbody, "PasteExcelGraph", RangetoHTML(rRng))
        .htmlbody = IIf(sComment1 = "", Replace(.htmlbody, "Comments:", ""), Replace(.htmlbody, "Comments:", StrBody1))
       .htmlbody = IIf(sComment2 = "", Replace(.htmlbody, "sComment2", ""), Replace(.htmlbody, "sComment2", StrBody2))
       .htmlbody = IIf(sComment3 = "", Replace(.htmlbody, "sComment3", ""), Replace(.htmlbody, "sComment3", StrBody3))
       .htmlbody = IIf(sComment4 = "", Replace(.htmlbody, "sComment4", ""), Replace(.htmlbody, "sComment4", StrBody4))
       .htmlbody = IIf(sComment5 = "", Replace(.htmlbody, "sComment5", ""), Replace(.htmlbody, "sComment5", StrBody5))      

       .display    ''/// Change this to .Send if you don't want to view the email before sending.

      End With
        On Error GoTo 0

clean_up:
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    Set OutMail = Nothing: Set OutApp = Nothing

End Sub