Если после выполнения макроса необходимо отправить в качестве вложения получившийся документ Excel, можно использовать следующий код. Он создаёт письмо с нужным перечнем адресатов в полях «Кому» и «Копия», с указанной темой, текстом и прикреплённым Excel файлом. Остаётся толкьо дописать письмо в случае необходимости и нажать кнопку «Отправить».

Dim OutlookApp As Object, SM As Object
 Set OutlookApp = CreateObject("Outlook.Application")
 Set SM = OutlookApp.CreateItem(olMailItem)
 'SM.SentOnBehalfOfName = "mail@example.ru" 'Поле "От", если нужен другой отправитель
 SM.To = "mail@example.ru" 'Поле "Кому"
 SM.CC = "mail@example.ru" 'Поле "Копия"
 SM.Subject = "Тема письма"
 On Error Resume Next
 SM.Body = "Текст письма"
 SM.Attachments.Add ("C:\Test.xls") 'Адрес вложения
 SM.Display
 Set SM = Nothing
 Set OutlookApp = Nothing

Если же нужно отправить письмо в фоновом режиме, без отображения и необходимости самостоятельно нажимать кнопку «Отправить», то вместо SM.Display нужно вставить следующий код:

 SM.Send
 OutlookApp.Quit

Чтобы вместо простого текста в теле письма было отформатированное содержимое можно воспользоваться вместо SM.Body следующее:

 SM.HTMLBody =  "<html><body><div>" & Text & "</div></body></html>"

Чтобы создать письмо с подписью, которая ставится по умолчанию, можно прибегнуть к следующему коду:

Sub cbSendMail_Click(FileName)
 Application.DisplayAlerts = False
 FullFilePath = ThisWorkbook.Path & "\" & FileName & ".xlsx"
 Dim OutlookApp As Object, SM As Object
 Set OutlookApp = CreateObject("Outlook.Application")
 Set SM = OutlookApp.CreateItem(olMailItem)
 SM.To = "mail@example.ru"
 SM.CC = "mail@example.ru"
 SM.Subject = "Название темы" & FileName
 On Error Resume Next
 'в этом случае открывается письмо 
 'с подписью той которая по умолчанию в Outlooke
 SM.Body = Activedocument.Content
 SM.HTMLBody = Activedocument.Content.Text
 If Dir(FullFilePath) <> "" Then
 SM.Attachments.Add (FullFilePath) 'Адрес вложения
 Else
 MsgBox "Файл для вложения не найден: " & Chr(13) & FullFilePath
 End If
 SM.Display
 SM.HTMLBody = "Добрый день!" & SM.HTMLBody
 Set SM = Nothing
 Set OutlookApp = Nothing
End Sub

Ещё по теме

Источник: Клуб ПРОграммистов — Отправка почты макросом Excel

Order_macros

Теги:
 

32 комментария в “Автоматическая отправка письма через Excel”

  1. Дмитрий:

    Здраствйуте!
    Очень полезный код, но под Windows 7 возникает ошибка: «ActiveX component can’t create object».
    Сталкивались Вы с такой проблемой?

    • Тоже Windows 7, но такой ошибки не возникало. Поискал в Интернете, может поможет замена строк

      Dim OutlookApp As Object, SM As Object
       Set OutlookApp = CreateObject("Outlook.Application")

      на следующий код

      Dim OutlookApp As Outlook.Application, SM As Object
       Set OutlookApp = New Outlook.Application

      Если поможет, то, пожалуйста, отпишитесь:)

  2. Олег:

    Доброго времени суток. Я в макросах полный ноль. Я понял что он отправляет целую книгу., а как сделать чтоб отправлял листы в книге( только так чтоб я прописывал название листов). Благодарю

  3. Олег:

    У меня большая база в эксель. У меня естьмакрос который разбивает по городам. Как отправлять без темы письма и текста я знаю(нашел), но в данный момент надо чтоб были эти фунцкия. Вот есть города, мне надо каждый лист отправлять отдельно. Получается 35 листов и это надо делть 2-3 раза в день. Если надо могу пример скинуть. Помогите пожалуйста

    • Соответственно сохраняете листы в 35 файлов, затем 35 писем в которые эти файлы вкладываете. И отправляете. Может скинуть пример, по возможности посмотрю.

  4. Евгений:

    Шикарный код, спасибо

  5. Илья:

    Отличный пример. VB не очень глубоко знаю, но здесь всё понятно!
    Спасибо!

  6. Андрей:

    Никогда не пишу комментарии, но тут не удержался — КОД ОФИГЕНЕН!!! Спасибо огромное!!!

  7. Тиль:

    Здравствуйте, подскажите пожалуйста, как дописать этот код, что бы можно было указать учетную запись, с которой отправляются письма? (У пользователя 2 почтовика в луке, для определенной рассылки необходимо выбрать не основной)
    Заранее благодарен.

    • Попробуйте использовать следующие параметры:

      Application.UserName

      или

      Environ("username")
      • Владислав:

        День Добрый!
        Не получается отправить письмо с не основного адреса.
        пробовал оба варианта. не совсем понятно в какое место надо вставлять данные пункты

  8. Андрей:

    Добрый день, а подскажите, пожалуйста, как дополнить макрос, чтобы он дополнительно в письме отправлял вложенный через гиперссылку файл?

    • Поясните, пожалуйста, точнее, что вы хотите: чтобы в письме была гиперссылка или чтобы какой-то файл по гиперссылке автоматически скачивался и вкладывался в письмо? Если первое, то нужно использовать HTMLBody и обычное оформление гиперссылки в HTML. Если второе, то это весьма нетривиальная задача, выходящая за рамки данной статьи.

  9. Андрей:

    Здравствуйте!
    Как сделать, чтобы в поле «Кому» записывалось сразу несколько e-mail адресов, которые предварительно были выбраны в таблице?

    Попробовал
    SM.To = ActiveCell
    но это работает только с одно выделенной ячейкой.

    • Попробуйте такой вариант:

      Sub cbSendMail_Click(FileName)
          Dim arr() As Variant
          Dim Rng As Range
          Dim myCell As Range
          Dim i As Integer
       
          Application.DisplayAlerts = False
       
          Set Rng = Selection
          SM_to = ""
          For Each myCell In Rng
            SM_to = myCell & "; " & SM_to
          Next myCell
       
          FullFilePath = ThisWorkbook.Path & "" & FileName & ".xlsx"
          Dim OutlookApp As Object, SM As Object
          Set OutlookApp = CreateObject("Outlook.Application")
          Set SM = OutlookApp.CreateItem(olMailItem)
          SM.To = SM_to
          SM.CC = "mail@example.ru"
          SM.Subject = "Название темы" & FileName
          On Error Resume Next
          'в этом случае открывается письмо
          'с подписью той которая по умолчанию в Outlooke
          SM.Body = Activedocument.Content
          SM.HTMLBody = Activedocument.Content.Text
          If Dir(FullFilePath) <> "" Then
          SM.Attachments.Add (FullFilePath) 'Адрес вложения
          Else
          MsgBox "Файл для вложения не найден: " & Chr(13) & FullFilePath
          End If
          SM.Display
          SM.HTMLBody = "Добрый день!" & SM.HTMLBody
          Set SM = Nothing
          Set OutlookApp = Nothing
      End Sub
  10. Роман:

    Всем привет!
    Очень полезный код, спасибо большое!
    Помогите пожалуйста добавить еще второго получателя в SM.To :
    SM.To = «mail@example.ru» + как добавить второго ?
    Пробовал через and и ;, но не получается…

  11. Артём:

    А если не через оутлук отправлять????
    Скажем, у пользователя почта на мэйле или гугле???
    Как тогда?

  12. AHKOP:

    Код с «создать письмо с подписью, которая ставится по умолчанию» это то, что я искал!
    Только подскажите, как отправить два или три прикрепленных к письму файлов?
    Спасибо.

  13. Дмитрий:

    Всем привет!
    Все замечательно!
    Подскажите как прикрепить все файлы к письму находящиеся на сетевой в папке с указанным расширением .htm ; .pdf ; без него.
    Спасибо.

    • Код для поиска всех файлов с папке с определённым расширением можете посмотреть на странице Полезные команды VBA в разделе Поиск файлов в папке. Этот цикл нужно добавить в код, формирующий новое письмо. Имейте ввиду, что размер файлов, которые можно отправить, ограничен!

  14. Master Vizitok:

    Александр, да можно. Только для этого либо Excel должен быть постоянно запущен, либо при открытии определенного файла будет идти проверка текущей даты и если дата больше-равна требуемой — то вызов кода отправки письма.

  15. Genrytomundew:

    Мне нужно отправить анкету с моими данными В каждую строку я внес свои данные, а как теперь мне отправить сообщение через эксель? У меня в семье есть компьютерщик, но он в отъезде, а мне нужно отправить через эксель письмо Посоветйуте с чего нужно начинать ?

    • Не совсем понятна ваша проблема. Может вам вообще не сюда, т.е. не нужен скрипт, а достаточно нажать Файл -> Сохранить и отправить -> Отправить по электронной почте -> Отправить как вложение (в зависимости от версии Офиса путь может отличаться).

  16. Тимур:

    Код шикарен и прост, долго искал код отправки сообщения с подписью

    Но, подскажите пожалуйста какую строчку кода надо прописать чтоб текст сообщения (Body) ссылался на ячейку на активном листе, и желательно чтобы текст можно было отформатировать

    ‘SM.HTMLBody = «Добрый день!» & SM.HTMLBody’

Комментировать