добавить подпись по умолчанию в почтовом ящике [дубликат]

Большинство других ответов просто конкатенируют их тело HTML с помощью HTML-подписи. Однако это не работает с изображениями, и, оказывается, существует более «стандартный» способ сделать это. 1

Microsoft Outlook pre-2007, настроенный с помощью WordEditor как его редактор, и Microsoft Outlook 2007 и далее, используйте слегка сокращенную версию Word Editor для редактирования электронных писем. Это означает, что мы можем использовать объектную модель документа 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 ответ, но обнаружил, что он не сохранил шрифты по умолчанию, которые являются специфичными для пользователя. Текст появился в системном шрифте как обычный текст. В приведенном ниже коде сохраняются любимые шрифты пользователя, хотя он делает это немного дольше. Он основан на подходе Mozzi , использует регулярное выражение для замены текстового текста по умолчанию и помещает выбранный пользователем текст тела, где он принадлежит, используя GetInspector.WordEditor. Я обнаружил, что вызов GetInspector не заполнил HTML-код, поскольку dimitry streblechenko говорит выше в этом потоке, по крайней мере, не в Office 2010, поэтому объект все еще отображается в моем коде. Промежуточно, обратите внимание, что важно, чтобы MailItem был создан как объект, а не как простой MailItem - см. здесь для более подробной информации. (О, и жаль те, у кого разные вкусы, но я предпочитаю более длинные описательные имена переменных, чтобы я мог найти подпрограммы!) [/ ​​G4]

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, "$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

Часто этот вопрос задается в контексте функции RangeToHTML Рона де Бруина, которая создает HTML PublishObject из Excel.Range, извлекает его через FSO и вставляет полученный поток HTML в адрес электронной почты HTMLBody. При этом удаляется подпись по умолчанию (функция RangeToHTML имеет вспомогательную функцию GetBoiler, которая пытается вставить подпись по умолчанию).

К сожалению, плохо документированный метод Application.CommandBars доступный через Outlook:

wdDoc.Application.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"

Он повысит время выполнения 6158:

Но мы все еще можем использовать Word.Document, доступный с помощью метода MailItem.GetInspector, мы можем сделать что-то подобное, чтобы скопировать & amp; вставьте выделение из 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, это может также вызвать некоторые неудобные проблемы выравнивания, но для простых таблиц и диапазонов Excel это очень хорошо:

Outlook добавляет подпись к новым немодифицированным сообщениям (вы не должны изменять тело до этого), когда вы вызываете MailItem.Display (что заставляет сообщение отображаться на экране) или когда вы получаете доступ к свойству MailItem.GetInspector - вам не нужно ничего делать с возвращенным объектом Inspector, но Outlook заполнит тело сообщения сигнатурой.

Как только подпись добавлена, прочитайте свойство HTMLBody и объедините его с HTML которую вы пытаетесь установить. Обратите внимание, что вы не можете просто объединить 2 строки HTML - строки должны быть объединены. Например. если вы хотите вставить строку в верхнюю часть тела HTML, найдите подстроку "<body", затем найдите следующее вхождение «>» (это касается элемента <body> с атрибутами), а затем вставьте свой HTML-код строка после этого «>».

Объектная модель Outlook вообще не обнаруживает подписи.

В общем примечании имя подписи хранится в данных профиля учетной записи, доступных через расширенный интерфейс MAPI IOlkAccountManager . Поскольку этот интерфейс является расширенным MAPI, его можно получить только с помощью C ++ или Delphi. Вы можете увидеть интерфейс и его данные в OutlookSpy , если вы нажмете кнопку IOlkAccountManager. Если у вас есть имя подписи, вы можете прочитать файл HTML из файловой системы (помните, что имя папки (подписи на английском языке) локализовано. Также имейте в виду, что если подпись содержит изображения, они также должны быть добавлены к сообщение в виде вложений и теги <img> в теле подписи / сообщения, скорректированные так, чтобы указывать атрибут src на вложения, а не на подпапку в папке «Подписи», где хранятся изображения. Это также будет вашей обязанностью объединить HTML-стили из HTML-файла подписи со стилями самого сообщения.

Если использовать 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 =   "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

EDIT: по состоянию на июль 2017 года MailItem.GetInspector в Outlook 2016 больше не вставляет подпись. Только MailItem.Display делает.

Мое решение состоит в том, чтобы сначала отобразить пустое сообщение (с сигнатурой по умолчанию!) и вставить предполагаемый strHTMLBody в существующий HTMLBody.

Если, как и 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

Я построил этот подход, ища, как отправить сообщение в повторяющийся график. Я нашел подход, в котором вы ссылаетесь на свойство 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

Я понял способ, но он может быть слишком неаккуратным для большинства. У меня есть простой Db, и я хочу, чтобы он мог генерировать электронные письма для меня, поэтому вот нижнее и грязное решение, которое я использовал:

Я обнаружил, что начало основного текста - это единственное место Я вижу «<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)

Я сделал ответ Community Wiki, потому что я не мог создать его без исследований PowerUser и помощи в более ранних комментариях.

Я взял PowerUser Sub X и добавил

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

после каждого утверждения. Из этого я обнаружил, что подпись не находится в пределах .HTMLBody до ObjMail.Display, и только тогда, когда я ничего не добавил в тело.

Я вернулся к предыдущему решению PowerUser, которое использовало C:\Users\" & Environ("username") & "\AppData\Roaming\Microsoft\Signatures\Mysig.txt") , PowerUser был недоволен этим, потому что он хотел, чтобы его решение работало для других, у которых были бы разные подписи.

Моя подпись находится в одной папке, и я не могу найти какой-либо опции для изменения этой папки. У меня есть только одна подпись, поэтому, читая только HTM-файл в этой папке, я получил мою единственную / стандартную подпись.

Я создал таблицу HTML и вставил ее в подпись сразу же после & lt; body & gt; и установите тело 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\Signatures, я предлагаю, чтобы это стандартное место для любой установки Outlook. Можно ли изменить это значение по умолчанию? Я не могу найти ничего, чтобы предложить это. Вышеприведенный код явно нуждается в некоторой разработке, но он добивается цели PowerUser по созданию тела электронной почты, содержащего HTML-таблицу над сигнатурой.

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

Просто подумал, что я поделюсь своим достижением. Не слишком уверен в правильности определения определяющих переменных, но он мал и легко читается, что мне нравится.

Я прикрепляю WMBody к .HTMLBody в объекте Outlook.Application OLE.

Надеюсь, что это кому-то поможет.

Спасибо, Уэс.