VBA添加签名邮件

Question

当我写下面的代码时，字体和大小是正确的，但签名缺失…您知道如何继续添加已在Outlook中创建的签名吗?

Sub mail_outlook()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.SentOnBehalfOfName = "xxxxxxxxxxxxxxxxxx"
.Display
.To = "xxxxxxxxxxxxxxxxxx"
.CC = "xxxxxxxxxxxxxxxxxx"
.BCC = ""
.Subject = "Report"

strbody = "<font style=""font-family: Calibri; font-size: 11pt;"">Hello,<p>Please find in attachment the Report.<p>We remain available should you have any questions."

End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Answer 1

这样的东西可能会起作用吗?只要更新你的签名名。

SigString = Environ("appdata") & _
"MicrosoftSignaturesMysig.htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
On Error Resume Next
strbody = "<font style=""font-family: Calibri; font-size: 11pt;"">Hello,<p>Please find in attachment the Report.<p>We remain available should you have any questions."

With OutMail
.To = "xxx"
.CC = "xxx"
.BCC = ""
.Subject = "Report"
.HTMLBody = strbody & "<br>" & Signature
.Send    'or use .Display
End With
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function

https://www.rondebruin.nl/win/s1/outlook/signature.htm