Pow*_*ser 43 outlook vba access-vba outlook-vba
我正在Access中编写一个VBA脚本,用于创建和自动填充几十封电子邮件.到目前为止,它一直是流畅的编码,但我是Outlook的新手.创建mailitem对象后,如何将默认签名添加到电子邮件中？
这将是创建新电子邮件时自动添加的默认签名.
理想情况下,我想使用ObjMail.GetDefaultSignature,但我找不到类似的东西.
目前,我正在使用下面的功能(在互联网上的其他地方找到)并引用htm文件的确切路径和文件名.但是这将由几个人使用,他们的默认htm签名文件可能有不同的名称.所以这可行,但它并不理想:
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
(称为getboiler(SigString = "C:\Users\" & Environ("username") & "\AppData\Roaming\Microsoft\Signatures\Mysig.txt"))
感谢JP(参见评论),我意识到默认签名首先出现,但是当我使用HTMLBody向电子邮件添加表格时它会消失.所以我想我现在的问题是:如何显示默认签名并仍显示html表？
Sub X()
Dim OlApp As Outlook.Application
Dim ObjMail As Outlook.MailItem
Set OlApp = Outlook.Application
Set ObjMail = OlApp.CreateItem(olMailItem)
ObjMail.BodyFormat = olFormatHTML
ObjMail.Subject = "Subject goes here"
ObjMail.Recipients.Add "Email goes here"
ObjMail.HTMLBody = ObjMail.Body & "HTML Table goes here"
ObjMail.Display
End Sub
小智 48
下面的代码将创建一个Outlook消息并保留自动签名
Dim OApp As Object, OMail As Object, signature As String
Set OApp = CreateObject("Outlook.Application")
Set OMail = OApp.CreateItem(0)
With OMail
.Display
End With
signature = OMail.body
With OMail
'.To = "someone@somedomain.com"
'.Subject = "Type your email subject here"
'.Attachments.Add
.body = "Add body text here" & vbNewLine & signature
'.Send
End With
Set OMail = Nothing
Set OApp = Nothing
小智 15
我的解决方案是首先显示一条空消息(使用默认签名!)并将目标strHTMLBody插入现有消息中HTMLBody.
如果像PowerUser所述,在编辑HTMLBody时签名被删除,您可以考虑在之后立即存储ObjMail.HTMLBody变量的内容并在之后添加,但这不是必需的.strTempObjMail.DisplaystrTemp
Sub X(strTo as string, strSubject as string, strHTMLBody as string)
Dim OlApp As Outlook.Application
Dim ObjMail As Outlook.MailItem
Set OlApp = Outlook.Application
Set ObjMail = OlApp.CreateItem(olMailItem)
ObjMail.To = strTo
ObjMail.Subject = strSubject
ObjMail.Display
'You now have the default signature within ObjMail.HTMLBody.
'Add this after adding strHTMLBody
ObjMail.HTMLBody = strHTMLBody & ObjMail.HTMLBody
'ObjMail.Send 'send immediately or
'ObjMail.close olSave 'save as draft
'Set OlApp = Nothing
End sub
小智 9
Dim OutApp As Object, OutMail As Object, LogFile As String
Dim cell As Range, S As String, WMBody As String, lFile As Long
S = Environ("appdata") & "\Microsoft\Signatures\"
If Dir(S, vbDirectory) <> vbNullString Then S = S & Dir$(S & "*.htm") Else S = ""
S = CreateObject("Scripting.FileSystemObject").GetFile(S).OpenAsTextStream(1, -2).ReadAll
WMBody = "<br>Hi All,<br><br>" & _
"Last line,<br><br>" & S 'Add the Signature to end of HTML Body
只是想我会分享我是如何做到这一点的.不太确定它是否在定义变量意义上是正确的,但它很小且易于阅读,这就是我喜欢的.
我在对象Outlook.Application OLE中将WMBody附加到.HTMLBody.
希望它可以帮助某人.
谢谢,韦斯.
当您调用MailItem.Display(导致消息显示在屏幕上)或访问该MailItem.GetInspector属性时,Outlook会将签名添加到新的未修改消息(您不应在此之前修改正文)- 您无需执行任何操作返回的Inspector对象,但Outlook将使用签名填充邮件正文.
添加签名后,读取HTMLBody属性并将其与您尝试设置的HTML字符串合并.请注意,您不能简单地连接2个HTML字符串 - 需要合并字符串.例如,如果要在HTML主体的顶部插入字符串,请查找"<body"子字符串,然后查找下一个">"(这将<body>使用属性处理元素),然后在">之后插入HTML字符串" ".
Outlook对象模型根本不公开签名.
一般说明,签名的名称存储在可通过IOlkAccountManager扩展MAPI接口访问的帐户配置文件数据中.由于该接口是扩展MAPI,因此只能使用C++或Delphi进行访问.如果单击按钮,则可以在OutlookSpy中查看界面及其数据IOlkAccountManager.
获得签名后,您可以从文件系统中读取HTML文件(请记住文件夹名称(英文签名)已本地化.
另请注意,如果签名包含图像,则还必须将其添加到作为附件的消息和<img>签名/消息正文中的标记被调整为指向src属性到附件而不是存储图像的Signatures文件夹的子文件夹.
您还有责任将签名HTML文件中的HTML样式与消息本身的样式合并.
如果使用Redemption是一个选项,则可以使用其RDOAccount对象(可以使用任何语言访问,包括VBA).新邮件签名名称存储在0x0016001F属性中,回复签名位于0x0017001F.您也可以使用RDOAccount.ReplySignature和NewSignature属性.
赎回也暴露了RDOSignature.ApplyTo获取指向RDOMail对象的指针并在指定位置插入签名正确合并图像和样式的方法:
set Session = CreateObject("Redemption.RDOSession")
Session.MAPIOBJECT = Application.Session.MAPIOBJECT
set Drafts = Session.GetDefaultFolder(olFolderDrafts)
set Msg = Drafts.Items.Add
Msg.To = "user@domain.demo"
Msg.Subject = "testing signatures"
Msg.HTMLBody = "<html><body>some <b>bold</b> message text</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.Send
编辑:截至2017年7月,MailItem.GetInspector在Outlook 2016中不再插入签名.只有MailItem.Display.
小智 5
我想出了一个办法，但对大多数人来说可能太草率了。我有一个简单的数据库，我希望它能够为我生成电子邮件，所以这是我使用的简陋的解决方案：
我发现正文的开头是我<div class=WordSection1>在新电子邮件的 HTMLBody 中看到“ ”的唯一地方，所以我只是做了一个简单的替换，替换
” <div class=WordSection1><p class=MsoNormal><o:p>“
和
"<div class=WordSection1><p class=MsoNormal><o:p>" & sBody
其中 sBody 是我想要插入的正文内容。到目前为止似乎有效。
.HTMLBody = Replace(oEmail.HTMLBody, "<div class=WordSection1><p class=MsoNormal><o:p>", "<div class=WordSection1><p class=MsoNormal><o:p>" & sBody)
我在寻找如何以定期计划发送消息的同时构建了这种方法.我发现你引用创建的消息的Inspector属性的方法没有添加我想要的签名(我在Outlook中设置了多个帐户,具有单独的签名.)
以下方法相当灵活,仍然很简单.
Private Sub Add_Signature(ByVal addy as String, ByVal subj as String, ByVal body as String)
Dim oMsg As MailItem
Set oMsg = Application.CreateItem(olMailItem)
oMsg.To = addy
oMsg.Subject = subj
oMsg.Body = body
Dim sig As String
' Mysig is the name you gave your signature in the OL Options dialog
sig = ReadSignature("Mysig.htm")
oMsg.HTMLBody = Item.Body & "<p><BR/><BR/></p>" & sig ' oMsg.HTMLBody
oMsg.Send
Set oMsg = Nothing
End Sub
Private Function ReadSignature(sigName As String) As String
Dim oFSO, oTextStream, oSig As Object
Dim appDataDir, sig, sigPath, fileName As String
appDataDir = Environ("APPDATA") & "\Microsoft\Signatures"
sigPath = appDataDir & "\" & sigName
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oTextStream = oFSO.OpenTextFile(sigPath)
sig = oTextStream.ReadAll
' fix relative references to images, etc. in sig
' by making them absolute paths, OL will find the image
fileName = Replace(sigName, ".htm", "") & "_files/"
sig = Replace(sig, fileName, appDataDir & "\" & fileName)
ReadSignature = sig
End Function