如何在Outlook中添加默认签名

我在Access中编写VBA脚本，创build并自动填充几十封电子邮件。 到目前为止，这一直是顺利的编码，但我是新的Outlook。 创buildmailitem对象后， 如何将默认签名添加到电子邮件 ？

  1. 这将是创build新电子邮件时自动添加的默认签名。

  2. 理想情况下，我想只使用ObjMail.GetDefaultSignature ，但我找不到像这样的东西。

  3. 目前，我正在使用下面的函数（在互联网上的其他地方 ），并引用了htm文件的确切path和文件名。 但是这将会被几个人使用，并且他们的默认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")调用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

下面的代码将创build一个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

我的解决scheme是首先显示一个空的消息（使用默认签名！），并将预期的strHTMLBody插入到现有的HTMLBody 。

如果像PowerUser状态一样，签名在编辑HTMLBody的时候被删除了，你可能会考虑将ObjMail.HTMLBody的内容立即存储在variablesObjMail.Display ，在strTemp之后立即添加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 
 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

只是想我会分享我如何实现这一点。 不太确定在定义variables的意义上它是否正确，但它很小，很容易阅读，而这正是我喜欢的。

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

希望它可以帮助别人。

谢谢，韦斯。

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

一旦添加了签名，请阅读HTMLBody属性并将其与您尝试设置的HTMLstring合并。 请注意，您不能简单地连接2个HTMLstring – string需要合并。 例如，如果要将string插入HTML主体的顶部，请查找"<body"子string，然后查找下一个出现的“>”（这将处理具有属性的<body>元素），然后插入你的HTMLstring后面的“>”。

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

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

如果使用Redemption是一个选项，则可以使用其RDOAccount对象（可以使用任何语言访问，包括VBA）。 新消息签名名称存储在0x0016001F属性中，回复签名位于0x0017001F 。 您也可以使用RDOAccount 。 ReplySignature和NewSignature属性。
赎回也暴露RDOS签名 。 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月，Outlook 2016中的MailItem.GetInspector不再插入签名。 只有MailItem.Display可以。

我做了这个社区Wiki的答案，因为如果没有PowerUser的研究和在以前的评论中的帮助，我不可能创build它。

我拿了PowerUser的Sub X并添加了 

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

在每一个陈述后。 从这里我发现签名不在.HTMLBody之前，直到.HTMLBody之后，然后只有我没有添加任何内容的时候。

我回到PowerUser早期使用C:\Users\" & Environ("username") & "\AppData\Roaming\Microsoft\Signatures\Mysig.txt")的解决scheme，PowerUser对此感到不满，因为他想要他的解决scheme为其他签名不同的人工作。

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

我创build了一个HTML表格，并将其插入到<body>元素之后的签名中，并将html正文设置为结果。 我给自己发了电子邮件，结果是完全可以接受的，只要你喜欢我的格式就可以了。

我修改的子程序是： 

 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

由于PowerUser和我都在C:\Users\" & Environ("username") & "\AppData\Roaming\Microsoft\Signaturesfind我们的签名，所以我build议这是任何Outlook安装的标准位置。 这个默认值可以改变吗？ 我无法find任何build议它可以。 上面的代码显然需要一些发展，但它确实达到了PowerUser创build包含签名上方的HTML表格的电子邮件主体的目的。

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

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

“ <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)

我在构build这种方法的同时寻找如何按照定期计划发送消息。 我发现你引用创build的消息的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

我需要50名代表发表评论反对签名选项，我发现最有帮助，但是我有一个问题，图像显示不正确，所以我不得不寻找一个解决办法。 这是我的解决scheme：

使用@Morris Maynard的答案作为基础https://stackoverflow.com/a/18455148/2337102然后，我不得不通过以下：;

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

  1. 您将使用SignatureName.htm和SignatureName_files Folder

  2. 你不需要HTML经验，这些文件将在一个编辑程序，如记事本或记事本++或您指定的HTML程序打开

  3. 导航到您的签名文件位置（标准应该是C:\Users\"username"\AppData\Roaming\Microsoft\Signatures ）

  4. 在文本/ htm编辑器中打开SignatureName.htm文件（右键单击文件“Edit with Program”）

  5. 使用Ctrl+F并input.png ; .jpg或者如果您不知道自己的图像types，请使用image001您将看到如下所示的内容： src="signaturename_files/image001.png"

  6. 您需要将其更改为图像位置C:\Users\YourName\AppData\Roaming\Microsoft\Signatures\SignatureNameFolder_files\image001的整个地址
    要么
    src="E:\location\Signatures\SignatureNameFolder_files\image001.png"

  7. 保存你的文件（覆盖它，你当然支持原来的）

  8. 返回到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."

  9. 运行你的macros事件，图像现在应该显示。

信用
MrExcel – VBA代码签名代码失败： http ://bit.ly/1gap9jY

其他大部分答案都是简单地将HTML正文与HTML签名连接起来。 但是，这不适用于图像，事实certificate，这是一个更“标准”的方式。 1

configurationWordEditor作为其编辑器的Microsoft Outlook 2007以及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编程（S. Mosher）>第17章，使用项目主体：使用Outlook签名

我喜欢Mozzi的回答，但发现它没有保留用户特定的默认字体。 文本全部以正常文本的forms出现在系统字体中。 下面的代码保留了用户最喜欢的字体，而使它更长一点。 它基于Mozzi的方法，使用正则expression式replace默认的正文文本，并使用GetInspector.WordEditor将用户所选的正文文本放置在所属的位置。 我发现GetInspector的调用并没有像这个线程中的dimitry streblechenko所说的那样填充HTMLbody，至less，不是在Office 2010中，所以对象仍然显示在我的代码中。 顺便提一下，请注意，MailItem是作为Object创build的，而不是作为一个简单的MailItem被创build的 – 请参阅这里了解更多信息。 （哦，对不同口味的人感到抱歉，但我更喜欢较长的描述性variables名称，以便find例程！） 

 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 (ie 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, "$1" & 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

在Ron de Bruin的RangeToHTML函数中，通常会问这个问题，它从Excel.Range创build一个HTML PublishObject ，通过FSO提取，并将生成的HTML插入到电子邮件的HTMLBody 。 这样做，这将删除默认签名（ RangeToHTML函数有一个帮助函数GetBoiler试图插入默认签名）。

不幸的是，文档不佳的Application.CommandBars方法不适用于Outlook： 

 wdDoc.Application.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"

它会引发一个运行时6158：

在这里输入图像描述

但是，我们仍然可以利用通过MailItem.GetInspector方法访问的Word.Document ，我们可以做这样的事情，从Excel复制和粘贴到Outlook电子邮件正文，保留您的默认签名（如果有）。 

 Dim rng as Range Set rng = Range("A1:F10") 'Modify as needed With OutMail .To = "xxxxx@xxxxx.com" .BCC = "" .Subject = "Subject" .Display Dim wdDoc As Object '## Word.Document Dim wdRange As Object '## Word.Range Set wdDoc = OutMail.GetInspector.WordEditor Set wdRange = wdDoc.Range(0, 0) wdRange.InsertAfter vbCrLf & vbCrLf 'Copy the range in-place rng.Copy wdRange.Paste End With

请注意，在某些情况下，这可能不会完美地保留列的宽度或在某些情况下的行高，而且它也将复制Excel范围内的形状和其他对象，这也可能会导致一些时髦的alignment问题，但对于简单的表和Excel范围，这是非常好的：

在这里输入图像描述

    Interesting Posts

    如何在Access 2007 VBA中显示“打开文件”对话框？

    确定对象是否是VBA中的集合的成员

    DoCmd.SetWarnings和CurrentDB.Execute之间有什么区别？

    使用Excel VBA将数据导出到MS Access表

    是否需要在VBA函数中将对象设置为Nothing

    在VBA中是否有等价于Thread.Sleep（）？

    VBA：在两种方式中声明一个新对象的区别？ （试图了解我的解决scheme为什么工作）

    如何使用Access / VBA复制到剪贴板？