Вставить в письмо подпись из Outlook через VBA
Последнее время стал часто встречать вопрос о том, как в письмо, созданное кодом VBA в Excel, добавить стандартную подпись Outlook.
Как делать отправку писем я рассказывал в этой статье: Как отправить письмо из Excel?
Немного теории для тех, кто не знает
Чтобы создать подпись в Excel 2007 и выше необходимо перейти в меню:
для 2007 : Сервис -Параметры -Сообщение -Подписидля 2010 и выше : Файл(File) -Параметры(Options) -Почта(Mail) -Подписи(Signatures)
В появившемся окне на вкладке Электронная подпись
В этой же вкладке можно настроить использование подписей по умолчанию для выбранной учетной записи(для каждой учетной записи можно назначить свою подпись по умолчанию) - в правой части окна.
Чтобы после создания письма вставить любую из созданных ранее подписей необходимо из окна созданного сообщения перейти на вкладку Вставка
Как я уже упоминал вначале статьи - из VBA так же можно создавать письма в Outlook. Подробнее об этом можно прочитать в этой статье: Как отправить письмо из Excel?. И вот там как раз есть небольшой недостаток - при создании письма подпись не добавляется автоматом, даже если она создана и настроена для вставки в новые сообщения. Это и побудило меня написать данную статью. Дело в том, что все созданные подписи хранятся на ПК в определенном месте на диске(
Sub SeeSigns() Dim sSignPath As String Dim sF sSignPath = Environ("appdata") & "\Microsoft\Signatures\" '" sF = Dir(sSignPath & "*.txt") Do While sF <> "" MsgBox sF, vbInformation, "www.excel-vba.ru" sF = Dir Loop End Sub |
Этот код просматривает только текстовые подписи - т.е. без оформления в виде картинок и гиперссылок. Однако в самой папке помимо текстовых файлов есть файлы с форматированием в формате .htm. Они добавляются в письма, которые пишутся с применением форматирования, т.е. письма формата .HTML.
Если в письмо надо вставить исключительно подпись по умолчанию(которая на данный момент установлена), то можно схитрить: в момент создания нового письма кодом создать еще одно временное пустое письмо, отобразить его, считать весь текст. Что произойдет: когда письмо отображается(objTmpMail.Display), встроенный алгоритм Outlook добавляет к нему подпись по умолчанию, даже если текста нет. А мы в итоге просто считываем эту подпись:
Option Explicit Sub Send_Mail() Dim objOutlookApp As Object, objMail As Object Dim sTo As String, sSubject As String, sBody As String, sAttachment As String Dim objTmpMail As Object 'временное письмо для создания подписи Application.ScreenUpdating = False On Error Resume Next 'пробуем подключиться к Outlook, если он уже открыт Set objOutlookApp = GetObject(, "Outlook.Application") Err.Clear 'Outlook закрыт, очищаем ошибку If objOutlookApp Is Nothing Then Set objOutlookApp = CreateObject("Outlook.Application") End If objOutlookApp.Session.Logon Set objMail = objOutlookApp.CreateItem(0) 'создаем новое сообщение 'если не получилось создать приложение или экземпляр сообщения - выходим If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub sTo = "AddressTo@mail.ru" 'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value) sSubject = "Автоотправка" 'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value) sBody = "Привет от Excel-VBA" 'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value) sAttachment = "C:\Temp\Книга1.xls" 'Вложение(полный путь к файлу. Можно заменить значением из ячейки - sAttachment = Range("A4").Value) 'создаем сообщение With objMail .To = sTo 'адрес получателя .CC = "" 'адрес для копии .BCC = "" 'адрес для скрытой копии .Subject = sSubject 'тема сообщения .body = sBody 'текст сообщения '.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.) .Attachments.Add sAttachment 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName 'добавляем подпись к письму 'создаем новое письмо Set objTmpMail = objOutlookApp.CreateItem(0) 'отображаем его - у него появится подпись objTmpMail.Display 'теперь к нашему текущему(рабочему) письму просто добавляем текст из временного objMail.body = objMail.body & objTmpMail.body 'удаляем временное письмо objTmpMail.Delete .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра End With Set objOutlookApp = Nothing: Set objMail = Nothing Application.ScreenUpdating = True End Sub |
Такой фокус не пройдет если ни одна подпись не установлена в качестве подписи по умолчанию.
Чтобы сильно не заморачивать всеми премудростями и хитросплетениями кодинга я просто приложу файл, который умеет создавать письма с подписями, при этом можно выбрать нужную подпись и тип: простой текст или форматированный.
Tips_Macro_CreateMailWithSign.xls (66,5 KiB, 2 472 скачиваний)
После скачивания файла прежде чем нажать кнопку
- в
В11 - адрес получателя(кому отправить письмо) - в
В12 - тема письма - в
В13 - текст письма
Если планируется отправить письмо с форматированием текста(жирный шрифт, различный цвет шрифта и т.п.) - то надо будет к письму применить теги HTML(ячейка
После нажатия Ок появится запрос:
Если нажать Нет
Рекомендую сначала пользоваться предпросмотром, чтобы понять как правильно создавать и форматировать письма.
Для тех, кто уже имеет опыт программирования в VBA, полагаю, не составит труда адаптировать код под какие-то свои коды или коды на этом сайте.
Если совсем не охота вдумываться в макросы и нужно готовое решение по рассылке с вложениями и подписями - есть готовое решение:

Так же см.:
Как отправить письмо из Excel?
Вставить в письмо Outlook таблицу Excel с форматированием
Сохранить вложения из Outlook в указанную папку
Как отправить письмо от другой учетной записи Outlook
Статья помогла? Поделись ссылкой с друзьями!

Поиск по меткам
Access apple watch Multex Power Query и Power BI VBA управление кодами Бесплатные надстройки Дата и время Записки Надстройки Печать Политика Конфиденциальности Почта Программы Работа с приложениями Разработка приложений Тренинги и вебинары Финансовые Форматирование Функции Excel акции MulTEx ссылкиКомментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум
Добрый день! Спасибо большое за вашу работу, очень помогает! Подскажите пожалуйста, как правильно вставить код подписи в Ваш готовый файл "Массовая рассылка писем по адресам", чтобы рассылка была с подписью?
Временное письмо не нужно. Достаточно отобразить письмо перед тем, как создавать его текст (body).
'создаем сообщение
With objMail
.To = sTo 'адрес получателя
.CC = "" 'адрес для копии
.BCC = "" 'адрес для скрытой копии
.Subject = sSubject 'тема сообщения
.Display
.body = sBody & .body 'текст сообщения до подписи
'.HTMLBody = sBody & .HTMLBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.)
.Attachments.Add sAttachment 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName
.Send 'если необходимо сразу отправить
End With
Сергей, все дело в том, что это не всегда срабатывает как положено. Поэтому и делается копия для более корректной вставки именно подписи.
А если у меня в подписи картинка? как правильно сделать?
у меня так этот кусок выглядит:
...
.body = sBody 'текст сообщения
.HTMLBody = sBody
.....