Lost your password?


Хитрости »
Основные понятия (26)
Сводные таблицы и анализ данных (10)
Графики и диаграммы (5)
Работа с VB проектом (12)
Power BI и Power Query (20)
Условное форматирование (5)
Списки и диапазоны (5)
Макросы(VBA процедуры) (68)
Разное (43)
Баги и глюки Excel (4)

Вставить в письмо подпись из Outlook через VBA

Последнее время стал часто встречать вопрос о том, как в письмо, созданное кодом VBA в Excel, добавить стандартную подпись Outlook.

Как делать отправку писем я рассказывал в этой статье: Как отправить письмо из Excel?

Немного теории для тех, кто не знает как создать и использовать подписи в Outlook. Дело в том, что в Outlook можно создавать несколько подписей и какую-то использовать по умолчанию, а остальные можно вставлять в письмо по необходимости.
Чтобы создать подпись в Excel 2007 и выше необходимо перейти в меню:

  • для 2007: Сервис -Параметры -Сообщение -Подписи
  • для 2010 и выше: Файл(File) -Параметры(Options) -Почта(Mail) -Подписи(Signatures)

Управление подписями Outlook
В появившемся окне на вкладке Электронная подпись(E-mail Signature) необходимо нажать кнопку Создать(New). Будет предложено ввести имя новой подписи. После чего необходимо подтвердить создание нажатием кнопки ОК и подпись будет добавлена. После добавления необходимо выбрать созданную подпись и добавить текст. Все созданные подписи отображаются в поле Выберите подпись для изменения(Select signature to edit). При выборе любой подписи в нижнем окне Изменить подпись(Edit signature) можно изменить как сам текст подписи и другие параметры: добавить/изменить текст, отформатировать его, вставить гиперссылки, картинки(логотип компании, например) и т.д. Для сохранения изменений необходимо нажать кнопку Сохранить(под верхним окном). Не очень интуитивненько, но как есть.
В этой же вкладке можно настроить использование подписей по умолчанию для выбранной учетной записи(для каждой учетной записи можно назначить свою подпись по умолчанию) - в правой части окна.
Чтобы после создания письма вставить любую из созданных ранее подписей необходимо из окна созданного сообщения перейти на вкладку Вставка(Insert) -Подписи(Signatures) и выбрать нужную подпись.

Как я уже упоминал вначале статьи - из VBA так же можно создавать письма в Outlook. Подробнее об этом можно прочитать в этой статье: Как отправить письмо из Excel?. И вот там как раз есть небольшой недостаток - при создании письма подпись не добавляется автоматом, даже если она создана и настроена для вставки в новые сообщения. Это и побудило меня написать данную статью. Дело в том, что все созданные подписи хранятся на ПК в определенном месте на диске(%AppData%\Microsoft\Signatures\) и до них можно достучаться. Правда, сэмулировать выбор подписи непосредственно из меню не представляется возможным, а вот определить наличие подписей и сделать их вставку можно. Перебрать все созданные подписи можно кодом:

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.


Создание письма кодом VBA с подписью по умолчанию
Если в письмо надо вставить исключительно подпись по умолчанию(которая на данный момент установлена), то можно схитрить: в момент создания нового письма кодом создать еще одно временное пустое письмо, отобразить его, считать весь текст. Что произойдет: когда письмо отображается(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

Такой фокус не пройдет если ни одна подпись не установлена в качестве подписи по умолчанию.


Создание письма кодом VBA с выбранной подписью
Чтобы сильно не заморачивать всеми премудростями и хитросплетениями кодинга я просто приложу файл, который умеет создавать письма с подписями, при этом можно выбрать нужную подпись и тип: простой текст или форматированный.
Скачать пример

  Tips_Macro_CreateMailWithSign.xls (66,5 KiB, 3 247 скачиваний)


После скачивания файла прежде чем нажать кнопку Создать письмо в Outlook с подписью надо будет настроить параметры письма в ячейках:

  • в В11 - адрес получателя(кому отправить письмо)
  • в В12 - тема письма
  • в В13 - текст письма

Форма выбора подписи
Если планируется отправить письмо с форматированием текста(жирный шрифт, различный цвет шрифта и т.п.) - то надо будет к письму применить теги HTML(ячейка В13). В файле я составил именно такой текст, чтобы был пример подобных писем. При этом для форматированного письма в форме следует выбрать пункт Форматированный текст (.htm). Иначе текст письма будет обычный, но со всеми тегами(ровно так, как он выглядит в самой ячейке на листе). Если форматирование не нужно - то просто записываем текст в ячейку и в форме выбираем Обычный текст (.txt).
После нажатия Ок появится запрос:
Запрос
Если нажать Нет(No), то письмо будет создано, подпись добавлена, но письмо не будет отправлено, а просто будет выведено на экран, чтобы можно было проверить правильно ли все заполнено и создано. Если нажать Да(Yes), то письмо будет создано и сразу отправлено, без вывода на экран.
Рекомендую сначала пользоваться предпросмотром, чтобы понять как правильно создавать и форматировать письма.
Для тех, кто уже имеет опыт программирования в VBA, полагаю, не составит труда адаптировать код под какие-то свои коды или коды на этом сайте.


Если совсем не охота вдумываться в макросы и нужно готовое решение по рассылке с вложениями и подписями - есть готовое решение: Отправка листа/книги по почте Отправка листа/книги по почте

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


Статья помогла? Поделись ссылкой с друзьями!
  Плейлист   Видеоуроки

Поиск по меткам

Access apple watch Multex Power Query и Power BI VBA управление кодами Бесплатные надстройки Дата и время Записки ИП Надстройки Печать Политика Конфиденциальности Почта Программы Работа с приложениями Разработка приложений Росстат Тренинги и вебинары Финансовые Форматирование Функции Excel акции MulTEx ссылки статистика
Обсуждение: 6 комментариев
  1. Денис:

    Добрый день! Спасибо большое за вашу работу, очень помогает! Подскажите пожалуйста, как правильно вставить код подписи в Ваш готовый файл "Массовая рассылка писем по адресам", чтобы рассылка была с подписью?

  2. Сергей:

    Временное письмо не нужно. Достаточно отобразить письмо перед тем, как создавать его текст (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
        .....

  3. Кирил:

    Здравствуйте, как отправить активную лист, и почему не работает удаление всех формул?
    За ранее благодарю!

    Option Explicit

    Sub КаТЗ()
    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 = "" 'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value)
    sSubject = "Часовые" 'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value)
    sBody = "" 'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value)
    sAttachment = "" 'Вложение(полный путь к файлу. Можно заменить значением из ячейки - sAttachment = Range("A4").Value)

    'создаем сообщение
    With objMail
    .ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value ' удалить строку, если формулы нужны
    .ReadReceiptRequested = True 'прочтение
    .OriginatorDeliveryReportRequested = True 'доставка
    .Importance = 2 'Варианты (0-normal, 1-low, 2-high)
    .To = sTo 'адрес получателя
    .CC = "" 'адрес для копии
    .BCC = "" 'адрес для скрытой копии
    .Subject = sSubject 'тема сообщения
    .Body = sBody 'текст сообщения
    .HTMLBody = sBody & .HTMLBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.)
    .Attachments.Add ActiveWorkbook.Sheets("Отправка КАТЗ").Copy 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName
    'добавляем подпись к письму
    'создаем новое письмо
    Set objTmpMail = objOutlookApp.CreateItem(0)
    'отображаем его - у него появится подпись
    objTmpMail.Display
    'теперь к нашему текущему(рабочему) письму просто добавляем текст из временного
    objMail.Body = objMail.Body & objTmpMail.Body
    objTmpMail.Delete 'удаляем временное письмо

    .Display 'Display/Send, если необходимо просмотреть сообщение, а не отправлять без просмотра
    End With

    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
    End Sub

Поделитесь своим мнением

Комментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум


Для оформления сообщений Вы можете использовать следующие тэги:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Тренинги

Заказать
Юридическая информация

Использование материалов сайта

Политика Конфиденциальности

ИП Щербаков Дмитрий Валентинович
ОГРНИП: 318502700083307
ИНН: 504013350772

Наши партнеры

Перейти
Перейти

Счетчики

Рейтинг@Mail.ru Яндекс.Метрика
© 2022 Excel для всех   Войти