VBA& HTMLBody - 正文和签名之间的间距

时间:2017-01-30 22:29:23

标签: html excel vba

我将使用excel向我的客户发送电子邮件,要求他们提供某些文件。我有一切工作,除了一个小细节,我不想使用它,直到我得到了1个细节。

我的电子邮件几乎完美填充,除了最后,“问候”和我的签名之间有大约3行空格。我不确定为什么会这样。它显示如下:

  

感谢您对此事的关注。

     

此致   
  
  
  
  签名

有谁知道如何修复它。我的代码如下:

Sub KYC_FATCA()

Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim signature As String

Dim AccOpen As String
Dim ConDoc As String
Dim SIP As String
Dim AFS As String
Dim W8 As String
Dim LEI As String

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
For Each cell In Columns("G").Cells.SpecialCells(xlCellTypeConstants)

    'KYC Account Opening Form
    If (Cells(cell.Row, "I").Value) = "No" Then
        AccOpen = "<b>KYC Account Opening Form</b> ." & "<br>" & "<br>"
    Else
        AccOpen = ""
    End If

    'Constating Document
    If (Cells(cell.Row, "J").Value) = "No" Then
        ConDoc = "<b>Constating Document</b> - ." & "<br>" & "<br>"
    Else
        ConDoc = ""
    End If

    'Statement of Policy and Guidelines (SIP&G)
    If (Cells(cell.Row, "L").Value) = "No" Then
        SIP = "<b>Statement of Policy and Guidelines (SIP&G)</b> - " & "<br>" & "<br>"
    Else
        SIP = ""
    End If

    'Audited Financial Statements (AFS)
    If (Cells(cell.Row, "M").Value) = "No" Then
        AFS = "<b>Audited Financial Statements (AFS)</b> - ." & "<br>" & "<br>"
    Else
        AFS = ""
    End If

    'W-8BEN-E Form
    If (Cells(cell.Row, "N").Value) = "No" Then
        W8 = "<b>W-8BEN-E Form</b> - " & "<br>" & "<br>"
    Else
        W8 = ""
    End If

    'Legal Entity Identifier (LEI)
    If (Cells(cell.Row, "O").Value) = "Needed" Then
        LEI = "<b>Legal Entity Identifier (LEI)</b> - " & "<br>" & "<br>"
    Else
        LEI = ""
    End If


    If cell.Value Like "?*@?*.?*" And _
       (Cells(cell.Row, "H").Value) = "yes" Then

        Set OutMail = OutApp.CreateItem(0)

        With OutMail
        .Display
        End With
        signature = OutMail.HTMLbody

        On Error Resume Next

        With OutMail
            .To = cell.Text 'Whatever is in cell G
            .cc = Cells(cell.Row, "C").Value

            'Testing if statements - The below one works perfect
            'If LCase(Cells(cell.Row, "Z").Value) = "" Then
            '    .cc = Cells(cell.Row, "P").Value
            'End If

            .Subject = Cells(cell.Row, "A").Value & " - " & "Documentation Request" _

            .HTMLbody = "<p style='font-family:calibri;font-size:11pt'>" & "Dear " & Cells(cell.Row, "D").Value & ",<br>" & "<br>" & _
            "On behalf of " & Cells(cell.Row, "B").Value & ", please by " & "<b><u>" & Cells(cell.Row, "Q").Text & "</b></u>" & "." & "<br>" & "<br>" & _
            AccOpen & _
            ConDoc & _
            SIP & _
            AFS & _
            W8 & _
            LEI & _
            "If you have any questions and/or concerns, please contract your Relationship Manager, " & Cells(cell.Row, "B").Value & "." & "<br>" & "<br>" & _
            "Thank you for your attention in this matter." & "<br>" & "<br>" & _
            "Regards," & "</p>" & _
            signature _

            'You can add files also like this
            If (Cells(cell.Row, "I").Value) = "No" Then
            .Attachments.Add ("C:doc")
            End If
            .Display  'This will open the message itself. If you'd like to send right away, use .Send

        End With

        On Error GoTo 0
        Set OutMail = Nothing

    End If

Next cell

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

1 个答案:

答案 0 :(得分:0)

问题在于这一行:

signature = OutMail.HTMLbody

这是获取签名的一种聪明方式,但默认的电子邮件正文在签名上方有几个空白行,并且在您连接电子邮件时会包含这些空白行。

我会在调试器中直观地检查signature并查看其中的内容,以及您不想要的remove the stuff。一个简单的例子可能是:

Function RemoveBlankStuff(ByVal text as string) as string
    text = text.Replace("<P></P>","") 'Remove any empty paragraphs
    text = text.Replace("<BR>","")    'Remove any line breaks
    Return text;
End Function

signature = RemoveBlankStuff(OutMail.HTMLBody);

您需要根据signature中的内容修改上述功能。