我正在尝试使用 VBA for Excel 自动处理一些电子邮件。到目前为止一切都很好,除了试图在电子邮件中保留我的签名。
一旦您告诉 VBA 创建新电子邮件,它将已经包含您的默认签名。如果您尝试
Outmail.Display
,就可以看到这一点。但是,如果您覆盖 .HTMLBody
属性,它将被删除。
我的简单尝试是将
.HTMLBody
的内容保存到 signature
(字符串),然后将其重新分配给 .HTMLBody
只是为了测试它。然而,生成的电子邮件将没有任何签名。
复制并重新插入签名的代码:
Dim myOlApp As Outlook.Application
Dim MyItem As Outlook.MailItem
Dim signature As String
Set myOlApp = CreateObject("Outlook.Application")
Set Outmail = myOlApp.CreateItem(0)
signature = Outmail.HTMLBody
Outmail.HTMLBody = signature
Outmail.Display
显示自动插入签名的代码:
Dim myOlApp As Outlook.Application
Dim MyItem As Outlook.MailItem
Set myOlApp = CreateObject("Outlook.Application")
Set Outmail = myOlApp.CreateItem(0)
Outmail.Display
编辑:我尝试用
.HTMLBody
替换 .Body
。这可行,但显然去掉了签名的 HTML 格式
编辑2:该代码在我朋友的计算机上运行,但在我的计算机上运行失败
我用这个技巧解决了这个问题:
Set myOutlook = CreateObject("Outlook.Application")
Set tempMail = myOutlook.CreateItem(olMailItem)
With tempMail
' Trick to preserve Outlook default signature
' MailItem need to be displayed to be "fully created" as object (maybe VBA bug)
.Display
HTMLBody = .HTMLBody
.Close olDiscard
' --- Trick to split HTMLBody into Head and Signature ---
' Search for the position of the tag before signature
bodyTag = "<body"
PosBody = InStr(HTMLBody, bodyTag)
pTag = "<o:p>"
PosSignature = InStr(PosBody, HTMLBody, pTag)
Head = Left(HTMLBody, PosSignature - 1)
Signature = Right(HTMLBody, Len(HTMLBody) - PosSignature + 1)
End With
然后您可以简单地将 HTML 文本放在 Head 和 Signature 之间:
Set myOutlook = CreateObject("Outlook.Application")
Set myMail = myOutlook.CreateItem(olMailItem)
With myMail
.To = Recipients
.Subject = Subject
.CC = CC
.HTMLBody = Head & "Here the HTML text of your mail" & Signature
End With
我认为这是一种 VBA 错误:如果您不使用 .Display 方法,则 MailItem 对象不会“完全”创建。
尝试放置一个制动点并查看 .Display 方法行之前和之后立即窗口 (Ctrl + G) 上的
?mymail.HTMLbody
值...
您也可以在本地窗口中获得相同的简单展开
mymail
对象!
解决了。只需重新启动 Outlook 即可解决。
另一个潜在的解决方案是直接从 Windows 存储签名的目录中获取签名并将其附加到正文中。 Microsoft MVP 在这里解释了(有点冗长)的过程:https://www.rondebruin.nl/win/s1/outlook/signature.htm
您可以从 Signatures 文件夹中读取签名文件(请记住,文件夹名称已本地化)并将其与消息正文合并(您不能简单地连接两个格式良好的 HTML 文档并获取有效的 HTML 文档)。您还需要小心签名样式和图像 - 它们必须单独处理。
您还可以显示消息(当显示消息时,Outlook 用签名填充未修改的消息正文),然后读取
HTMLBody
属性并关闭检查器(闪烁是不可避免的)。如果您仍想显示该消息,请先显示该消息,以便 Outlook 插入签名,然后再添加您的数据(需要插入,而不是串联)。
如果使用 Redemption (我是其作者)是一个选项,它会公开 RDOSignature 对象。您可以使用其
ApplyTo
方法将任何签名插入到任何消息中。
set Session = CreateObject("Redemption.RDOSession")
Session.MAPIOBJECT = Application.Session.MAPIOBJECT
set Drafts = Session.GetDefaultFolder(olFolderDrafts)
set Msg = Drafts.Items.Add
Msg.To = "[email protected]"
Msg.Subject = "testing signatures"
Msg.HTMLBody = "<html><body>some <b>bold</b> message text<br></body></html>"
set Account = Session.Accounts.GetOrder(2).Item(1) 'first mail account
if Not (Account Is Nothing) Then
set Signature = Account.NewMessageSignature
if Not (Signature Is Nothing) Then
Signature.ApplyTo Msg, false 'apply at the bottom
End If
End If
Msg.Display
我正在 Word 文档上编写一个“提交”按钮以将其发送给支持人员,并发现下面的解决方案可提供签名。该 VBA 在 Excel 电子表格上的工作方式相同,只需将 Word 的引用替换为 Excel 对象即可。基本上,在请求签名之前,您必须先调用 .Display 命令。添加正文时,电子邮件消息上有一点“闪光”,但我发现我可以接受:-)。
Private Sub btnSubmit_Click()
On Error Resume Next
Dim objOutlook As Object
Dim objEmail As Object
Dim objDoc As Document
Dim emailMsg As String
'let's turn off the screen for a bit...
Application.ScreenUpdating = False
Set objOutlook = CreateObject("Outlook.Application")
Set objEmail = objOutlook.CreateItem(0) '0=olMailItem
'the 'Submit' button is on this Word document, so we'll need
'to save the file before we can attach it...
Set objDoc = ActiveDocument
objDoc.Save
emailMsg = "Here's the body of the email... edit as needed."
'send the email
objEmail.Subject = "Testing Outlook Signatures"
objEmail.bodyFormat = 2 '2=olFormatHTML
objEmail.To = "[email protected]"
objEmail.Importance = 1 '1=olImportantceNormal
objEmail.Attachments.Add objDoc.FullName
'if we don't call this, the email message isn't 'real' yet...
objEmail.Display
'NOW, we can add the message and the HTML Body,
'which is where the signature is...
objEmail.HTMLBody = emailMsg & objEmail.HTMLBody
'we'll do some cleanup here
Set objDoc = Nothing
Set objEmail = Nothing
Set objOutlook = Nothing
Application.ScreenUpdating = True
End Sub
这是对我有用的功能,我按如下方式使用它。
.HTMLBody = "我的电子邮件文本" & GetOutlookSignature()
功能代码:
Function GetOutlookSignature() As String
Dim fso As Object
Dim ts As Object
Dim strSig As String
Dim strHTML As String
On Error Resume Next
' Path of Outlook signature file
sigPath = Environ("APPDATA") & "\Microsoft\Signatures\"
' Checks if the signatures folder exists
If Dir(sigPath, vbDirectory) <> "" Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(sigPath & Dir(sigPath & "*.htm"))
strSig = ts.ReadAll
ts.Close
Set fso = Nothing
Set ts = Nothing
' Convert signature to HTML format
strHTML = Replace(strSig, vbCrLf, "<br>")
' Remove trailing empty lines
Do While Right(strHTML, 4) = "<br>"
strHTML = Left(strHTML, Len(strHTML) - 4)
Loop
GetOutlookSignature = strHTML
Else
GetOutlookSignature = ""
End If
End Function
剪切签名的 html 源代码(例如在编辑器或 mozilla - 源代码视图中),然后将其复制到单元格中。然后你可以将单元格的值添加到你的 .htmlbody 中,那就完美了。所有其他解决方案都很糟糕,我都尝试过:)