如何添加 HTMLBody 签名?

How to add HTMLBody Signature?

我需要在生成的 Outlook 电子邮件末尾添加我的签名。

我将我的 (.HTMLBody = msg) 更改为 (.HTMLBody = msg & .HTMLBody)。这让我的签名显示,但我的消息文本消失了。当我删除末尾的 .HTMLBody 并使用我的原始代码时,我的文本显示格式正确但没有签名。

Sub Email()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Path As String
    Dim strbody As String

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

    msg = "<p>Hello World,</p><br>"

    On Error Resume Next
    With OutMail
        .Display
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Fruits Stock " & Path
        .HTMLBody = msg & "Hello World" & .HTMLBody
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

您是否使用 Google 搜索过关于 MailItem.HTMLBody 的内容?

示例here:

Sub CreateHTMLMail() 
 
 'Creates a new email item and modifies its properties. 
 
 Dim objMail As Outlook.MailItem 
 
 
 
 'Create email item 
 
 Set objMail = Application.CreateItem(olMailItem) 
 
 With objMail 
 
 'Set body format to HTML 
 
 .BodyFormat = olFormatHTML 
 
 .HTMLBody = _ 
 
 "<HTML><BODY>Enter the message text here. </BODY></HTML>" 
 
 .Display 
 
 End With 
 
End Sub

如果您希望您的电子邮件采用 HTMl 格式,您需要设置一个标志:

.BodyFormat = olFormatHTML


查找 MailItem.BodyFormat 属性.

我在创建用于发送具有特定签名的电子邮件的循环时遇到了类似的问题。在我的例子中,我不得不从几个签名中选择一个,因为每封电子邮件可能会有所不同。

我将签名名称作为字符串变量 Signame 传递到一个单独的函数中,用于将签名添加到电子邮件中。

'Code trimmed down a lot to just relevant bits
Sub Email()
'Create email here
Dim Email as outlook.mailitem, OutApp as Object
Set OutApp = CreateObject("Outlook.Application")
Set Email = OutApp.Createitem(olMailItem)
'Email Content:
Email.Htmlbody = "<p>Hello World</p>" & AddSig("My_Signature")
Email.display
End Sub

Function AddSig(Signame as string)
If Len(Signame) > 0 Then
    Dim fso As Object, ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject"): Set ts = fso.GetFile(Environ("Appdata") & "\Microsoft\Signatures\" & Signame & ".htm").OpenAsTextStream(1, -2)
    Signame = Replace(Signame, " ", "%20")
    AddSig = "<br>" & Replace(ts.ReadAll, _
        Signame & "_files", _
        Replace(Environ("Appdata"), " ", "%20") & "\Microsoft\Signatures\" & Signame & "_files")
End If
End Function

在我放置“My_Signature”的地方替换你的签名名称。

这不适用于名称中带有 space 的签名,尽管我对 Signame = Replace(Signame, " ", "%20") 做出了努力 - 这与 HTML 有关。我刚刚重命名我的签名以删除所有 spaces.