如何在Excel VBA电子邮件中添加签名？
当用户单击一行中的单元格时，我使用此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 & _ "FAO: " & "<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 当您调用MailItem.Display （这会导致邮件显示在屏幕上）或您访问MailItem.GetInspector属性时，Outlook会将签名添加到新的未修改的邮件（您不应在此之前修改邮件正文）不必对返回的Inspector对象进行任何操作，但Outlook将使用签名来填充消息正文。
一旦添加了签名，请阅读HTMLBody属性并将其与您尝试设置的HTMLstring合并。 请注意，您不能简单地连接2个HTMLstring – string需要合并。 例如，如果要将string插入HTML主体的顶部，请查找<body substring，然后查找下一个> （这将处理带有属性的<body>元素），然后在您的HTMLstring之后插入那> 。 embedded的图像附件和样式必须分开处理。
一般情况下，签名的名称存储在通过IOlkAccountManager扩展MAPI接口可访问的帐户configuration文件数据中。 由于该接口是扩展MAPI，因此只能使用C ++或Delphi进行访问。 如果您单击IOlkAccountManagerbutton，您可以在OutlookSpy中看到该界面及其数据。
Outlook对象模型不公开签名或访问帐户的任意属性。
如果使用Redemption是一个选项，则可以使用其RDOAccount对象（可用任何语言访问，包括VBA）。 新消息签名名称存储在0x0016001F属性中，回复签名位于0x0017001F。 您也可以使用RDOAccount 。 ReplySignature和NewSignature属性。
所有Outlook签名都通过RDOSession.Signatures集合公开。
使用RDOSignature.ApplyTo可以将签名应用于消息 – 它将负责正确合并数据并引入embedded的图像附件和样式。
编辑 ：截至2017年夏天，只有MailItem.Display在Outlook 2016中插入签名MailItem.GetInspector不再那样做。
在Outlook 2007工具 – 选项 – 邮件格式选项卡按住Ctrl键并单击签名
保存签名的文件夹将打开，并显示path和文件名称。 这将是用于调用下面的GetSignature函数的path和文件名。
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
在您的发送电子邮件代码中，声明一个stringvariables来保存从GetSignature函数返回的签名文本。 一旦设置，那么string就需要被附加到电子邮件正文的末尾。
Dim StrSignature As String StrSignature = GetSignature(sPath) .HTMLbody = strbody & vbNewLine & vbNewLine & StrSignature
有相同的问题，尤其是当使用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