Question

当用户点击一行中的单元格时，我使用此VBA代码发送电子邮件。

我想将带有图片的签名添加到我的电子邮件正文中。我怎么能修改我的代码才能把它放进去？

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column = Range("BL1").Column Then

     If Target.Row > 7 And Target.Value = "Take Action" Then

         Set OutApp = CreateObject("Outlook.Application")
         Set OutMail = OutApp.CreateItem(0)

         strbody = "<p style='font-family:calibri;font-size:16'>" & "Dear Sirs," & "<br><br>" & vbNewLine & vbNewLine & _
              "F.A.O: " & "<b>" & Range("B" & ActiveCell.Row) & "</b>" & "," & vbNewLine & vbNewLine & _
              "<br>" & "This is an urgent update on the status of your account." & "<br>" & vbNewLine & _
              "Our records show that your insurance is due to expire on: " & "<b>" & Format(Range("BE" & ActiveCell.Row), "dd" & " Mmmm " & "yyyy") & "." & "</b>" & " To ensure that you remain active on our systems as an approved Hewden Stuart Ltd Supplier, it is important that you provide us with the details of your renewed insurance policy. Please can you provide us with these details for the following insurance as soon as possible, in order to remain active on our systems:" & vbNewLine & vbNewLine & _
              "<br><br>" & "Insurance: " & "<b>" & "{Insurance Type Goes Here}" & "</b>" & "<br>" & vbNewLine & _
              "Due for Period: " & "<b>" & Format(Range("BE" & ActiveCell.Row), "dd" & " Mmmm " & "yyyy") & "</b>" & " - " & "<b>" & Format(Range("BE" & ActiveCell.Row) + 365, "dd" & " Mmmm " & "yyyy") & "</b>" & vbNewLine & vbNewLine & _
              "<br><br>" & "Note:" & "<br>" & vbNewLine & _
              "Please ensure that the above information is provided by your insurance broker, or your insurer, in the form of a standard letter or certificate. If your insurance is in the name of a parent company, please provide a breakdown of the companies covered from your insurer. In order to provide us with the above information, please login to your Control Panel with your unique Username and Password and attach your documents. Regrettably, failure to provide us with the information requested will result in suspension of your account. If you have any queries, please email us at SupplierAudits@Hewden.co.uk." & vbNewLine & vbNewLine & _
              "<br><br>" & "Your Reference:" & "<br><br>" & vbNewLine & vbNewLine & _
              "<b>" & Range("AB" & ActiveCell.Row) & "</b>" & vbNewLine & _
              "<p style='font-family:calibri;font-size:13'>" & "Please quote your unique Supplier Reference number when providing us with any insurance documents and in the even that you should have any enquiries." & "</p>" & vbNewLine & vbNewLine & _
              "<p style='font-family:calibri;font-size:16'>" & "<br>" & "Kind Regards," & "<br><br>" & vbNewLine & vbNewLine & _
              "<b>" & "Hewden Supply Chain Department" & "</b>" & "</P>"

        With OutMail
            .SentOnBehalfOfName = "newsuppliers@hewden.co.uk"
            .To = "mark.o'brien@hewden.co.uk"
            .CC = ""
            .BCC = ""
            .Subject = "Important! - Insurance Alert!"
            .HTMLbody = strbody
            .Attachments.Add ("P:\cover.jpg")
            .Send   'or use .Display
        End With

    End If

End If

End Sub

Answer 1

当您调用MailItem.Display（导致消息显示在屏幕上）或访问{{}时，Outlook会将签名添加到新的未修改消息（您不应在此之前修改正文） 1}} property - 您不必对返回的Inspector对象执行任何操作，但Outlook将使用签名填充邮件正文。

添加签名后，请阅读MailItem.GetInspector属性并将其与您尝试设置的HTML字符串合并。请注意，您不能简单地连接2个HTML字符串 - 需要合并字符串。例如。如果要在HTML正文的顶部插入字符串，请查找HTMLBody子字符串，然后查找<body的下一个匹配项（这会处理带有属性的>元素），然后在<body>之后插入HTML字符串。嵌入式图像附件和样式必须单独处理。

一般情况下，签名的名称存储在可通过IOlkAccountManager扩展MAPI界面访问的帐户配置文件数据中。由于该接口是扩展MAPI，因此只能使用C ++或Delphi进行访问。如果单击>按钮，则可以在OutlookSpy中查看界面及其数据。

Outlook对象模型不会公开签名或访问帐户的任意属性。

如果使用Redemption是一个选项，则可以使用其RDOAccount对象（可以使用任何语言访问，包括VBA）。新的消息签名名称存储在0x0016001F属性中，回复签名在0x0017001F中。您还可以使用RDOAccount。IOlkAccountManager和ReplySignature属性所有Outlook签名都通过RDOSession.Signatures集合公开可以使用RDOSignature.ApplyTo将签名应用于邮件 - 它将正确地合并数据并引入嵌入的图像附件和样式。

编辑：截至2017年夏季，只有NewSignature在Outlook 2016中插入签名。MailItem.Display不再这样做了。

Answer 2

在Outlook 2007中工具 - 选项 - 邮件格式选项卡按住cntrl键并单击“签名”

将保留保存签名的文件夹，并显示路径和文件名。这将是用于调用下面的GetSignature函数的路径和文件名。

Function GetSignature(fPath As String) As String  
    Dim fso As Object  
    Dim TSet As Object  
    Set fso = CreateObject("Scripting.FileSystemObject")  
    Set TSet = fso.GetFile(fPath).OpenAsTextStream(1, -2)  
    GetSignature= TSet.readall  
    TSet.Close  
End Function

在您的发送电子邮件代码中，声明一个字符串变量以保存从GetSignature函数返回的签名文本。设置完成后，需要将字符串附加到电子邮件正文的末尾。

Dim StrSignature As String
StrSignature = GetSignature(sPath)

.HTMLbody = strbody & vbNewLine & vbNewLine & StrSignature

Answer 3

有同样的问题，特别是在使用HTMLbody时。而不是使用它：

    With OutMail
    .SentOnBehalfOfName = "newsuppliers@hewden.co.uk"
    .To = "mark.o'brien@hewden.co.uk"
    .CC = ""
    .BCC = ""
    .Subject = "Important! - Insurance Alert!"
    .HTMLbody = strbody
    .Attachments.Add ("P:\cover.jpg")
    .Send   'or use .Display
    End With*

你应该这样做：

    With OutMail
    .SentOnBehalfOfName = "newsuppliers@hewden.co.uk"
    .To = "mark.o'brien@hewden.co.uk"
    .CC = ""
    .BCC = ""
    .Subject = "Important! - Insurance Alert!"
    ''''' part that is missing
    . Display
    End with
    With OutMail
    '''''
    .HTMLbody = strbody & vbNewLine & .HTMLBody ' add the signature without losing the HTML-formatting of the signature
    .Attachments.Add ("P:\cover.jpg")
    .Send   'or use .Display
    End With

如何在Excel VBA电子邮件中添加签名？

3 个答案: