Question

我有一个电子邮件模板和一些生成电子邮件的代码。在电子邮件模板中，我有以下内容：

评论：

评论1
评论2
评论3
评论4
评论5

代码使用replace函数替换Excel单元格中的comment1。在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

从VBA代码生成电子邮件模板中删除多余的空行

0 个答案: