vba 如何在 Outlook 中添加默认签名

Question

提问by PowerUser

I am writing a VBA script in Access that creates and auto-populates a few dozen emails. It's been smooth coding so far, but I'm new to Outlook. After creating the mailitem object, how do I add the default signature to the email?

我正在 Access 中编写一个 VBA 脚本，用于创建和自动填充几十封电子邮件。到目前为止，编码一直很顺利，但我是 Outlook 的新手。创建 mailitem 对象后，如何将默认签名添加到电子邮件？

This would be the default signature that is automatically added when creating a new email.
Ideally, I'd like to just use ObjMail.GetDefaultSignature, but I can't find anything like it.
Currently, I'm using the function below (found elsewhereon the internet) and referencing the exact path & filename of the htm file. But this will be used by several people and they may have a different name for their default htm signature file. So this works, but it's not ideal:
```
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
```
(Called with getboiler(SigString = "C:\Users\" & Environ("username") & "\AppData\Roaming\Microsoft\Signatures\Mysig.txt"))

这将是创建新电子邮件时自动添加的默认签名。
理想情况下，我只想使用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")）

Edit

编辑

Thanks to JP (see comments), I realize that the default signature is showing up at first, but it disappears when I use HTMLBody to add a table to the email. So I guess my question is now: How do I display the default signature and still display an html table?

感谢 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

Answer 1

回答by Julia Jones

The code below will create an outlook message & keep the auto signature

下面的代码将创建一个 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 = "[email protected]"
    '.Subject = "Type your email subject here"
    '.Attachments.Add
    .body = "Add body text here" & vbNewLine & signature
    '.Send
End With

Set OMail = Nothing
Set OApp = Nothing

Answer 2

回答by Rick van Dam

My solution is to display an emptymessage first (with default signature!) and insert the intended strHTMLBodyinto the existing HTMLBody.

我的解决方案是首先显示一条空消息（带有默认签名！）并将预期strHTMLBody插入到现有的HTMLBody.

If, like PowerUser states, the signature is wiped out while editing HTMLBody you might consider storing the contents of ObjMail.HTMLBodyinto variable strTempimmediately after ObjMail.Displayand add strTempafterwards but that should not be necessary.

如果像 PowerUser 状态一样，在编辑 HTMLBody 时签名被清除，您可能会考虑将其内容立即存储ObjMail.HTMLBody到变量中strTemp，ObjMail.Display然后再添加strTemp，但这不是必需的。

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

Answer 3

回答by Wesley

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

Just thought I'd share how I achieve this. Not too sure if it's correct in the defining variables sense but it's small and easy to read which is what I like.

只是想我会分享我是如何实现这一目标的。不太确定它在定义变量意义上是否正确，但它很小且易于阅读，这是我喜欢的。

I attach WMBody to .HTMLBody within the object Outlook.Application OLE.

我将 WMBody 附加到 Outlook.Application OLE 对象中的 .HTMLBody。

Hope it helps someone.

希望它可以帮助某人。

Thanks, Wes.

谢谢，韦斯。

Answer 4

回答by Dmitry Streblechenko

Outlook adds the signature to the new unmodified messages (you should not modify the body prior to that) when you call MailItem.Display(which causes the message to be displayed on the screen) or when you access the MailItem.GetInspectorproperty - you do not have to do anything with the returned Inspector object, but Outlook will populate the message body with the signature.

当您调用MailItem.Display（这会导致消息显示在屏幕上）或访问该MailItem.GetInspector属性时，Outlook 会将签名添加到新的未修改消息中（在此之前您不应修改正文）- 您无需执行任何操作返回的 Inspector 对象，但 Outlook 将使用签名填充邮件正文。

Once the signature is added, read the HTMLBodyproperty and merge it with the HTML string that you are trying to set. Note that you cannot simply concatenate 2 HTML strings - the strings need to be merged. E.g. if you want to insert your string at the top of the HTML body, look for the "<body"substring, then find the next occurrence of ">" (this takes care of the <body>element with attributes), then insert your HTML string after that ">".

添加签名后，读取该HTMLBody属性并将其与您尝试设置的 HTML 字符串合并。请注意，您不能简单地连接 2 个 HTML 字符串 - 需要合并这些字符串。例如，如果您想在 HTML 正文的顶部插入您的字符串，请查找"<body"子字符串，然后找到下一次出现的 ">"（这会处理<body>具有属性的元素），然后在 "> 之后插入您的 HTML 字符串”。

Outlook Object Model does not expose signatures at all.

Outlook 对象模型根本不公开签名。

On a general note, the name of the signature is stored in the account profile data accessible through the IOlkAccountManagerExtended MAPI interface. Since that interface is Extended MAPI, it can only be accessed using C++ or Delphi. You can see the interface and its data in OutlookSpyif you click the IOlkAccountManagerbutton.
Once you have the signature name, you can read the HTML file from the file system (keep in mind that the folder name (Signatures in English) is localized.
Also keep in mind that if the signature contains images, they must also be added to the message as attachments and the <img>tags in the signature/message body adjusted to point the srcattribute to the attachments rather than a subfolder of the Signatures folder where the images are stored.
It will also be your responsibility to merge the HTML styles from the signature HTML file with the styles of the message itself.

一般而言，签名的名称存储在可通过IOlkAccountManager扩展 MAPI 接口访问的帐户配置文件数据中。由于该接口是扩展 MAPI，因此只能使用 C++ 或 Delphi 进行访问。如果单击该按钮，您可以在OutlookSpy 中看到界面及其数据IOlkAccountManager。
有了签名名称后，您就可以从文件系统中读取 HTML 文件（请记住，文件夹名称（英文签名）是本地化的。
另外请记住，如果签名包含图像，还必须将它们添加到作为附件的邮件和<img>签名/邮件正文中的标签调整为指向src属性到附件而不是存储图像的签名文件夹的子文件夹。
您还需要负责将签名 HTML 文件中的 HTML 样式与消息本身的样式合并。

If using Redemptionis an option, you can use its RDOAccountobject (accessible in any language, including VBA). New message signature name is stored in the 0x0016001Fproperty, reply signature is in 0x0017001F. You can also use the RDOAccount.ReplySignatureand NewSignatureproperties.
Redemption also exposes RDOSignature.ApplyTomethod that takes a pointer to the RDOMailobject and inserts the signature at the specified location correctly merging the images and the styles:

如果使用Redemption是一个选项，您可以使用它的RDOAccount对象（可以用任何语言访问，包括 VBA）。新消息签名名称存储在0x0016001F属性中，回复签名在0x0017001F. 您还可以使用RDOAccount。ReplySignature和NewSignature属性。
Redemption 还公开了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 =   "[email protected]"
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

EDIT: as of July 2017, MailItem.GetInspectorin Outlook 2016 no longer inserts the signature. Only MailItem.Displaydoes.

编辑：截至 2017 年 7 月，MailItem.GetInspector在 Outlook 2016 中不再插入签名。只会MailItem.Display。

Answer 5

回答by Mozzis

I constructed this approach while looking for how to send a message on a recurring schedule. I found the approach where you reference the Inspector property of the created message did not add the signature I wanted (I have more than one account set up in Outlook, with separate signatures.)

我在寻找如何定期发送消息时构建了这种方法。我发现您引用所创建邮件的 Inspector 属性的方法没有添加我想要的签名（我在 Outlook 中设置了多个帐户，并带有单独的签名。）

The approach below is fairly flexible and still simple.

下面的方法相当灵活，而且仍然很简单。

    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

Answer 6

回答by MrsAdmin

I need 50 rep to post a comment against the Signature Option I found most helpful, however I had an issue with images not showing correctly so I had to find a work around. This is my solution:

我需要 50 位代表对我认为最有帮助的签名选项发表评论，但是我遇到了图像无法正确显示的问题，因此我必须找到解决方法。这是我的解决方案：

Using @Morris Maynard's answer as a base https://stackoverflow.com/a/18455148/2337102I then had to go through the following:

使用@Morris Maynard 的答案作为基础https://stackoverflow.com/a/18455148/2337102然后我必须完成以下操作：

Notes:
Back up your .htm file before starting, copy & paste to a secondary folder

注意：
在开始之前备份您的 .htm 文件，复制并粘贴到辅助文件夹

You will be working with both the SignatureName.htmand the SignatureName_files Folder
You do not need HTMLexperience, the files will open in an editing program such as Notepad or Notepad++ or your specified HTML Program
Navigate to your Signature File location (standard should be C:\Users\"username"\AppData\Roaming\Microsoft\Signatures)
Open the SignatureName.htmfile in a text/htm editor (right click on the file, "Edit with Program")
Use Ctrl+Fand enter .png; .jpgor if you don't know your image type, use image001You will see something like: src="signaturename_files/image001.png"
You need to change that to the whole address of the image location C:\Users\YourName\AppData\Roaming\Microsoft\Signatures\SignatureNameFolder_files\image001
or
src="E:\location\Signatures\SignatureNameFolder_files\image001.png"
Save your file (overwrite it, you had of course backed up the original)
Return to Outlook and Open New Mail Item, add your signature. I received a warning that the files had been changed, I clicked ok, I needed to do this twice, then once in the "Edit Signatures Menu".
Some of the files in this webpage aren't in the expected location. Do you want to download them anyway? If you're sure the Web page is from a trusted source, click Yes."
Run your Macro event, the images should now be showing.

您将同时SignatureName.htm与SignatureName_files Folder
您无需HTML经验，文件将在 Notepad 或 Notepad++ 等编辑程序或您指定的 HTML 程序中打开
导航到您的签名文件位置（标准应该是C:\Users\"username"\AppData\Roaming\Microsoft\Signatures）
SignatureName.htm在 text/htm 编辑器中打开文件（右键单击文件，“使用程序编辑”）
使用Ctrl+F并输入.png；.jpg或者如果您不知道您的图像类型，请使用image001您将看到如下内容： src="signaturename_files/image001.png"
您需要将其更改为图像位置的整个地址 C:\Users\YourName\AppData\Roaming\Microsoft\Signatures\SignatureNameFolder_files\image001
或
src="E:\location\Signatures\SignatureNameFolder_files\image001.png"
保存您的文件（覆盖它，您当然已经备份了原始文件）
返回 Outlook 并打开新邮件项目，添加您的签名。我收到了文件已更改的警告，我点击了确定，我需要这样做两次，然后在“编辑签名菜单”中执行一次。
Some of the files in this webpage aren't in the expected location. Do you want to download them anyway? If you're sure the Web page is from a trusted source, click Yes."
运行您的宏事件，现在应该显示图像。

Credit
MrExcel - VBA code signature code failure: http://bit.ly/1gap9jY

Credit
MrExcel - VBA 代码签名代码失败：http://bit.ly/1gap9jY

Answer 7

回答by Eliot K

I figured out a way, but it may be too sloppy for most. I've got a simple Db and I want it to be able to generate emails for me, so here's the down and dirty solution I used:

我想出了一个方法，但对大多数人来说可能太草率了。我有一个简单的 Db，我希望它能够为我生成电子邮件，所以这是我使用的肮脏的解决方案：

I found that the beginning of the body text is the only place I see the "<div class=WordSection1>" in the HTMLBody of a new email, so I just did a simple replace, replacing

我发现正文的开头是我<div class=WordSection1>在新邮件的 HTMLBody 中唯一看到“ ”的地方，所以我只是做了一个简单的替换，替换

"<div class=WordSection1><p class=MsoNormal><o:p>"

“ <div class=WordSection1><p class=MsoNormal><o:p>”

with

和

"<div class=WordSection1><p class=MsoNormal><o:p>" & sBody

where sBody is the body content I want inserted. Seems to work so far.

其中 sBody 是我要插入的正文内容。到目前为止似乎工作。

.HTMLBody = Replace(oEmail.HTMLBody, "<div class=WordSection1><p class=MsoNormal><o:p>", "<div class=WordSection1><p class=MsoNormal><o:p>" & sBody)

Answer 8

回答by Tony Dallimore

I have made this a Community Wiki answer because I could not have created it without PowerUser's research and the help in earlier comments.

我已将此作为社区 Wiki 答案，因为如果没有 PowerUser 的研究和早期评论中的帮助，我无法创建它。

I took PowerUser's Sub Xand added

我拿了 PowerUser'sSub X并添加了

Debug.Print "n------"    'with different values for n
Debug.Print ObjMail.HTMLBody

after every statement. From this I discovered the signature is not within .HTMLBodyuntil after ObjMail.Displayand then only if I haven't added anything to the body.

在每个语句之后。从这里我发现签名不是在.HTMLBody直到之后ObjMail.Display，然后只有当我没有向身体添加任何东西时。

I went back to PowerUser's earlier solution that used C:\Users\" & Environ("username") & "\AppData\Roaming\Microsoft\Signatures\Mysig.txt"). PowerUser was unhappy with this because he wanted his solution to work for others who would have different signatures.

我回到 PowerUser 早期使用C:\Users\" & Environ("username") & "\AppData\Roaming\Microsoft\Signatures\Mysig.txt"). PowerUser 对此不满意，因为他希望他的解决方案适用于具有不同签名的其他人。

My signature is in the same folder and I cannot find any option to change this folder. I have only one signature so by reading the only HTM file in this folder, I obtained my only/default signature.

我的签名在同一个文件夹中，我找不到任何更改此文件夹的选项。我只有一个签名，因此通过读取此文件夹中唯一的 HTM 文件，我获得了我的唯一/默认签名。

I created an HTML table and inserted it into the signature immediately following the <body> element and set the html body to the result. I sent the email to myself and the result was perfectly acceptable providing you like my formatting which I included to check that I could.

我创建了一个 HTML 表并将其插入到紧跟在 <body> 元素之后的签名中，并将 html body 设置为结果。我向自己发送了电子邮件，结果完全可以接受，前提是您喜欢我包含的格式以检查我是否可以。

My modified subroutine is:

我修改后的子程序是：

Sub X()

  Dim OlApp As Outlook.Application
  Dim ObjMail As Outlook.MailItem

  Dim BodyHtml As String
  Dim DirSig As String
  Dim FileNameHTMSig As String
  Dim Pos1 As Long
  Dim Pos2 As Long
  Dim SigHtm As String

  DirSig = "C:\Users\" & Environ("username") & _
                               "\AppData\Roaming\Microsoft\Signatures"

  FileNameHTMSig = Dir$(DirSig & "\*.htm")

  ' Code to handle there being no htm signature or there being more than one

  SigHtm = GetBoiler(DirSig & "\" & FileNameHTMSig)
  Pos1 = InStr(1, LCase(SigHtm), "<body")

  ' Code to handle there being no body

  Pos2 = InStr(Pos1, LCase(SigHtm), ">")

  ' Code to handle there being no closing > for the body element

   BodyHtml = "<table border=0 width=""100%"" style=""Color: #0000FF""" & _
         " bgColor=#F0F0F0><tr><td align= ""center"">HTML table</td>" & _
         "</tr></table><br>"
  BodyHtml = Mid(SigHtm, 1, Pos2 + 1) & BodyHtml & Mid(SigHtm, Pos2 + 2)

  Set OlApp = Outlook.Application
  Set ObjMail = OlApp.CreateItem(olMailItem)
  ObjMail.BodyFormat = olFormatHTML
  ObjMail.Subject = "Subject goes here"
  ObjMail.Recipients.Add "my email address"
  ObjMail.Display

End Sub

Since both PowerUser and I have found our signatures in C:\Users\" & Environ("username") & "\AppData\Roaming\Microsoft\SignaturesI suggest this is the standard location for any Outlook installation. Can this default be changed? I cannot find anything to suggest it can. The above code clearly needs some development but it does achieve PowerUser's objective of creating an email body containing an HTML table above a signature.

由于 PowerUser 和我都在中找到了我们的签名，因此C:\Users\" & Environ("username") & "\AppData\Roaming\Microsoft\Signatures我建议这是任何 Outlook 安装的标准位置。这个默认可以改吗？我找不到任何东西表明它可以。上面的代码显然需要一些开发，但它确实实现了 PowerUser 的目标，即创建包含签名上方的 HTML 表格的电子邮件正文。

Answer 9

回答by Birdie

Most of the other answers are simply concatenating their HTML body with the HTML signature. However, this does not work with images, and it turns out there is a more "standard" way of doing this.1

大多数其他答案只是将其 HTML 正文与 HTML 签名连接起来。但是，这不适用于图像，事实证明有一种更“标准”的方法可以做到这一点。1

Microsoft Outlook pre-2007 which is configured with WordEditor as its editor, and Microsoft Outlook 2007 and beyond, use a slightly cut-down version of the Word Editor to edit emails. This means we can use the Microsoft Word Document Object Model to make changes to the email.

Microsoft Outlook 2007 之前的版本配置为 WordEditor 作为其编辑器，而 Microsoft Outlook 2007 及更高版本则使用稍微精简版的 Word 编辑器来编辑电子邮件。这意味着我们可以使用 Microsoft Word 文档对象模型对电子邮件进行更改。

Set objMsg = Application.CreateItem(olMailItem)
objMsg.GetInspector.Display 'Displaying an empty email will populate the default signature
Set objSigDoc = objMsg.GetInspector.WordEditor
Set objSel = objSigDoc.Windows(1).Selection
With objSel
   .Collapse wdCollapseStart
   .MoveEnd WdUnits.wdStory, 1
   .Copy 'This will copy the signature
End With
objMsg.HTMLBody = "<p>OUR HTML STUFF HERE</p>"
With objSel
   .Move WdUnits.wdStory, 1 'Move to the end of our new message
   .PasteAndFormat wdFormatOriginalFormatting 'Paste the copied signature
End With 
'I am not a VB programmer, wrote this originally in another language so if it does not
'compile it is because this is my first VB method :P

Microsoft Outlook 2007 Programming (S. Mosher)> Chapter 17, Working with Item Bodies: Working with Outlook Signatures

Microsoft Outlook 2007 编程 (S. Mosher)> 第 17 章，使用项目正文：使用 Outlook 签名

Answer 10

回答by Neil Dunlop

I like Mozzi's answer but found that it did not retain the default fonts that are user specific. The text all appeared in a system font as normal text. The code below retains the user's favourite fonts, while making it only a little longer. It is based on Mozzi's approach, uses a regular expression to replace the default body text and places the user's chosen Body text where it belongs by using GetInspector.WordEditor. I found that the call to GetInspector did notpopulate the HTMLbody as dimitry streblechenkosays above in this thread, at least, not in Office 2010, so the object is still displayed in my code. In passing, please note that it is important that the MailItem is created as an Object, not as a straightforward MailItem - see herefor more. (Oh, and sorry to those of different tastes, but I prefer longer descriptive variable names so that I can find routines!)

我喜欢Mozzi的回答，但发现它没有保留用户特定的默认字体。文本都以系统字体作为普通文本出现。下面的代码保留了用户最喜欢的字体，同时让它的时间变长了一点。它基于Mozzi的方法，使用正则表达式替换默认正文文本，并使用 GetInspector.WordEditor 将用户选择的正文文本放置在其所属的位置。我发现，调用GetInspector根本没有填充HTMLbody为迪米特里streblechenko上面在这个线程中说，至少在 Office 2010 中没有，所以对象仍然显示在我的代码中。顺便说一下，请注意将 MailItem 创建为对象而不是简单的 MailItem 很重要 - 请参阅此处了解更多信息。（哦，对于不同口味的人，我很抱歉，但我更喜欢更长的描述性变量名称，以便我可以找到例程！）

Public Function GetSignedMailItemAsObject(ByVal ToAddress As String, _
                      ByVal Subject As String, _
                      ByVal Body As String, _
                      SignatureName As String) As Object
'================================================================================================================='Creates a new MailItem in HTML format as an Object.
'Body, if provided, replaces all text in the default message.
'A Signature is appended at the end of the message.
'If SignatureName is invalid any existing default signature is left in place.
'=================================================================================================================
' REQUIRED REFERENCES
' VBScript regular expressions (5.5)
' Microsoft Scripting Runtime
'=================================================================================================================
Dim OlM As Object               'Do not define this as Outlook.MailItem.  If you do, some things will work and some won't (i.e. SendUsingAccount)
Dim Signature As String
Dim Doc As Word.Document
Dim Regex As New VBScript_RegExp_55.RegExp       '(can also use use Object if VBScript is not Referenced)

Set OlM = Application.CreateItem(olMailItem)
With OlM
    .To = ToAddress
    .Subject = Subject
    'SignatureName is the exactname that you gave your signature in the Message>Insert>Signature Dialog
    Signature = GetSignature(SignatureName)
    If Signature <> vbNullString Then
'        Should really strip the terminal </body tag out of signature by removing all characters from the start of the tag
'        but Outlook seems to handle this OK if you don't bother.
        .Display                                'Needed.  Without it, there is no existing HTMLbody available to work with.
        Set Doc = OlM.GetInspector.WordEditor   'Get any existing body with the WordEditor and delete all of it
        Doc.Range(Doc.Content.Start, Doc.Content.End) = vbNullString 'Delete all existing content - we don't want any default signature
        'Preserve all local email formatting by placing any new body text, followed by the Signature, into the empty HTMLbody.
        With Regex
            .IgnoreCase = True                  'Case insensitive
            .Global = False                     'Regex finds only the first match
            .MultiLine = True                   'In case there are stray EndOfLines (there shouldn't be in HTML but Word exports of HTML can be dire)
            .Pattern = "(<body.*)(?=<\/body)"   'Look for the whole HTMLbody but do NOT include the terminal </body tag in the value returned
            OlM.HTMLbody = .Replace(OlM.HTMLbody, "" & Signature)
        End With ' Regex
        Doc.Range(Doc.Content.Start, Doc.Content.Start) = Body 'Place the required Body before the signature (it will get the default style)
        .Close olSave                           'Close the Displayed MailItem (actually Object) and Save it.  If it is left open some later updates may fail.
    End If ' Signature <> vbNullString
End With ' OlM
Set GetSignedMailItemAsObject = OlM
End Function

Private Function GetSignature(sigName As String) As String
Dim oTextStream As Scripting.TextStream
Dim oSig As Object
Dim appDataDir, Signature, sigPath, fileName As String
Dim FileSys As Scripting.FileSystemObject        'Requires Microsoft Scripting Runtime to be available
    appDataDir = Environ("APPDATA") & "\Microsoft\Signatures"
    sigPath = appDataDir & "\" & sigName & ".htm"
    Set FileSys = CreateObject("Scripting.FileSystemObject")
    Set oTextStream = FileSys.OpenTextFile(sigPath)
    Signature = oTextStream.ReadAll
    ' fix relative references to images, etc. in Signature
    ' by making them absolute paths, OL will find the image
    fileName = Replace(sigName, ".htm", "") & "_files/"
    Signature = Replace(Signature, fileName, appDataDir & "\" & fileName)
    GetSignature = Signature
End Function

vba 如何在 Outlook 中添加默认签名

提问by PowerUser

Edit

编辑

回答by Julia Jones

回答by Rick van Dam

回答by Wesley

回答by Dmitry Streblechenko

回答by Mozzis

回答by MrsAdmin

回答by Eliot K

回答by Tony Dallimore

回答by Birdie

回答by Neil Dunlop

相关推荐

最近更新

标签

vba 如何在 Outlook 中添加默认签名

提问by PowerUser

Edit

编辑

回答by Julia Jones

回答by Rick van Dam

回答by Wesley

回答by Dmitry Streblechenko

回答by Mozzis

回答by MrsAdmin

回答by Eliot K

回答by Tony Dallimore

回答by Birdie

回答by Neil Dunlop

相关推荐

vba 根据outlook邮件更新excel表

vba 具有多个 OR 条件的 Countif

vba 如何在 VB6 中不打开 CMD 窗口的情况下运行 shell 命令

vba 将带有换行符的txt文件导入Excel

相关推荐

最近更新

标签