VBA 和 HTMLBody - 正文和簽名之間的間距

Question

我將使用 excel 向我的客戶發送電子郵件，要求他們提供某些文件。 除了 1 個小細節之外，我一切都在工作，並且在弄清楚 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

Answer 1

問題是這一行：

signature = OutMail.HTMLbody

這是獲取簽名的一種聰明方法，但是默認電子郵件正文在簽名上方有幾個空白行，並且在連接電子郵件時會包括這些空白行。

我會在調試器中直觀地檢查signature ，然后查看其中的內容，然后刪除不需要的內容 。 一個簡單的示例可能是：

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找到的內容來修改上述功能。

Answer 2

S-

我正在做類似的事情並遇到同樣的問題。

如果您替換這部分代碼，這應該可以工作：

        With OutMail
        .Display
        End With
        signature = OutMail.HTMLbody

使用以下代碼 - 它有效地打開、刪除空格，並刪除/丟棄為獲取簽名而創建的電子郵件：

  'gets default signature from e-mail
    With OutMail
        '2 = HTMLBody
        .BodyFormat = 2
        .Display
        'deletes blank space present before signature
        signature = Replace(OutMail.HTMLBody, "<p class=MsoNormal><o:p>&nbsp;</o:p></p>", "")
        'removes entire e-mail contents and then closes with discard
        OutMail.HTMLBody = Replace(OutMail.HTMLBody, OutMail.HTMLBody, "")
        OutMail.Close 1
    End With

不確定它是否有所作為，但在 .HTMLBody 中，我也開始 -

.HTMLBody = .HTMLBody & "Good Afternoon," & "<br>" & "whateveryourtextis" & "Thanks," & "<br><br>" & signature