Макрос VBA для отправки почтовых сообщений может быть полезен пользователям, адресные книги которых ведутся в рабочих книгах Excel, а также тем, кто занимается e-mail маркетингом. Ниже приведен программный код макроса, отправляющего электронное письмо через почтовый клиент MS Outlook.
Перед запуском макроса необходимо прописать существующие адреса электронной почты для полей "Кому" и "Копия" и указать путь к существующему файлу, который будет приложением к письму (либо закомментировать строку).
Макрос для отправки электронного письма
Этот же макрос будет работать и при отправке письма из Word, а вот аналогичный макрос для MS Outlook.
Для того, чтобы перенести этот программный код на свой компьютер, наведите курсор мыши на поле с программным кодом, нажмите на одну из двух кнопкок 
в правом верхнем углу этого поля, скопируйте программный код и вставьте его в модуль проекта на своем компьютере (подробнее о том, как сохранить программный код макроса).
Надстройка для рассылки электронной почты
Если добавить к приведенному выше коду цикл, а значения, заключенные в кавычки, заменить на значения, содержащиеся в ячейках рабочей книги Excel, создать пользовательскую форму, через которую пользователем будут задаваться необходимые диапазоны, то получится инструмент для рассылки писем электронной почты прямо из Excel.
Если вам нужно рассылать письма из Excel,
воспользуйтесь готовым решением в виде надстройки FillDocuments
Пример макроса, отправляющего письма со вложениями из Excel через почтовый клиент Outlook:
Макрос использует функцию SendEmailUsingOutlook, которая:
- принимает в качестве параметров адрес получателя письма, тему и текст письма, список вложений
- запускает Outlook, формирует письмо, и отправляет его
- возвращает TRUE, если отправка прошла успешно, или FALSE, если с отправкой почты вызникли проблемы
Код функции SendEmailUsingOutlook:
Пример макроса, с получением параметров письма из ячеек листа Excel:
- 99078 просмотров
Комментарии
Отправка email без помощи outlook. а через CDO
Если в ячейке А1 значение будет больше 2 тогда отправиться почта. Появится сообщение "Письмо отправлено".
Для того чтобы это работало нужно настроить макрос.
Вот что нужно сделать:
1. В excel нажать "Alt+F11". Откроется окно Visual Basic.
В главном меню окна выбрать Tools-References. В открывшемся окне найти "Microsoft CDO for Windows 2000 Library", напротив него поставить галочку и нажать кнопку "ОК". Сохранить файл.
Это нужно сделать только один раз.
2. В окне Visual Basic в левом верхнем углу увидите окно Project. В нем нужно двойным щелкчом щелкнуть по "Лист1 (Лист1)". Этим самым вы в правом окне откроете код макроса.
Этот код вам нужно заточить под себя.
Зеленым цветом даны комментарии, поэтому вам должно быть все понятно.
Прописываете там свой почтовый ящик, пароль, почтовый ящик получателя, тему сообщения, текст сообщения.
Все сохраняете.
Добрый вечер! Спасибо за макрос. Подскажите, пожалуйста, как добавить в тело письма информацию об отправителе из поля Подпись Outlook? Извините за глупый вопрос.
Здравствуйте, Сергей
Оформляйте заказ на сайте http://excelvba.ru/order/send
прикрепляйте примеры файлов, и подробно описывайте, что откуда и куда должно вставляться в письмо, — тогда сделаю.
Доброго времени суток!
Есть необходимость отправлять отчёты в виде таблицы 2х10 ячеек в письме через outlook более десятка раз на день.
В теме письма макрос на отправку через excel из 1й ячейки, на диапазон найти не могу. Необходимо что бы отправлялось письмо на 3х адресатов, с табличкой внутри сообщения из файла. Вариант с прикреплённым файлом не подходит. Помогите с написанием кода плс.
Мой макрос работает только под Windows
Как на Маке сделать — не знаю, нет Мака для тестирования
Добрый день
Запускаю макрос, но выскакивает сообщение "Не удалось запустить OUTLOOK. "
Outlook запущен, работает нормально
У меня Mac, возможно нужен другой код?
Доброго времени суток! Подскажите пожалуйста, нужен макрос для отправки фиксированного диапазона ячеек A14:N25 через аутлук в теле письма в виде куска таблицы
Нашел макрос на отправку файла, вот только не могу понять в каком формате нужно прописать attachment?
Sub Send_Mail()
Dim objOutlookApp As Object, objMail As Object
Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
Application.ScreenUpdating = False
On Error Resume Next
Set objOutlookApp = CreateObject("Outlook.Application")
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 ‘адрес получателя
.Subject = sSubject ‘тема сообщения
.Body = sBody ‘текст сообщения
.Attachments.Add sAttachment
.Send ‘Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
End With
exit_:
Set objOutlookApp = Nothing: Set objMail = Nothing
Application.ScreenUpdating = True
End Sub
Можем сделать под заказ.
Добрый день.
Отправка писем данным макросом работает прекрасно, но можно добавить параметр который отвечает за отправку письма не сразу, а в назначенную дату и время ?
Необходима рассылка уведомлений за 10 дней до контрольной даты.
Заранее спасибо за ответ.
Александр, я не консультирую по бесплатным макросам, тем более, если они написаны не мной.
Обратитесь на форумы по Excel, там помогут.
Здравствуйте,снова 🙂
Пошел по Вашему совету =>
1. сначала файл сохраняю в формате .pdf в определенной папке
2. Отправляю файл с прикреплением этого файла из определенной папки
Вот только проблемка, он файл сохраняет, но ничего не отправляется.
Sub save_in_pdf_and_send_email()
Dim s$
s = "C:Usersalexander.leontyevDesktop60_SQA10. Supplier perfomanceSP"
MakeSureDirectoryPathExists s
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
s & "Supplier Perfomance — " & Range("b3") & " — " & Range("b4") & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
Dim objOutlookApp As Object, objMail As Object
Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
Application.ScreenUpdating = False
On Error Resume Next
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 = Range("ac3") & ";" & Range("ac4") & ";" & Range("ac5") & ";" & Range("ac6") ‘Кому(можно заменить значением из ячейки — sTo = Range("A1").Value)
sSubject = "Supplier Performance — " & Range("b3") & " — " & Range("b4") ‘Тема письма(можно заменить значением из ячейки — sSubject = Range("A2").Value)
sBody = "We inform you that we are appreciated you by point evaluation => more detailed description is presented in the attached file"
sAttachment = "C:Usersalexander.leontyevDesktop60_SQA10. Supplier perfomanceSP" & "Supplier Perfomance — " & Range("b3") & " — " & Range("b4") & ".pdf" ‘Вложение(полный путь к файлу. Можно заменить значением из ячейки — sAttachment = Range("A4").Value)
With objMail
.To = Range("ac3") & ";" & Range("ac4") & ";" & Range("ac5") & ";" & Range("ac6")
.CC = Range("ad4") & ";" & Range("ad5") & ";" & Range("ad6")
.BCC = ""
.Subject = "Supplier Performance — " & Range("b3") & " — " & Range("b4")
.Body = "We inform you that we are appreciated you by point evaluation => more detailed description is presented in the attached file"
End With
Set objOutlookApp = Nothing: Set objMail = Nothing
Application.ScreenUpdating = True
Спасибо большое, сейчас попробую 🙂
1. листа в формате PDF не существует.
если хотите его прикрепить, — сначала надо сохранить этот лист в формате PDF в файл
иначе — никак. впрочем, это происходит моментально и незаметно для пользователя, если макрос правильно написан
ваш код тут не подойдет, — он подходит только для отправки книги в обычном формате (Excel)
для PDF нужен совсем другой код (с использованием CDO или почтовой программы типа Outlook)
2. в четвёртой строке, в коде ошибка: .CC = Range("h25") & Range("h26") тут не в тему
метод SendMail объекта Workbook не поддерживает указание получателей копии в таком виде (надо указывать массив текстовых значений)
попробуйте заменить четвертую строку следующим:
1. Помогите пожалуйста скорректировать макрос, так чтобы он вкладывал в письмо лист в формате PDF (не сохраняя на рабочем столе, потом прописывать чтобы из папки вставлял и прочее)
2. Скорректировать макрос, чтобы вставлял помимо основных получателей, еще получателей для копии письма (основные адреса указаны у меня в ячейках H21, H22, а для копии в ячейках H25, H26)
1. Sub send_emails()
2. ThisWorkbook.Sheets("SP").Copy
3. With ActiveWorkbook
4. .SendMail Recipients:=Range("h21") & Range("h22").CC = Range("h25") & Range("h26"), Subject:="SP"
5. .Close SaveChanges:=False
6. End With
7. End Sub
P.S.
для составления данного макроса пользовался интернетом, вот только не нашел как вставить лист в формате .pdf и получателей для копии не работает)
Замените "почта куда отправлять" на Range("D2")
где D2 — адрес ячейки с адресом почты
Здравствуйте, написала макрос для отправки через Outlook письма со вложенной екселевской табличкой. Помогите.
Sub SendWorkbook()
ActiveWorkbook.SendMail Recipients:="моя почта", Subject:="Лови файлик"
End Sub
Sub SendSheet()
ThisWorkbook.Sheets("рассылка").Copy
With ActiveWorkbook
.SendMail Recipients:="почта куда отправлять", Subject:="Лови файлик"
.Close SaveChanges:=False
End With
End Sub
Но можно ли, чтобы указывался не конкретный адрес куда отправлять, а из конкретной ячейки брать значение. Спасибо
просто .CC = Email$, .BCC = Email$ (скрытая)
Игорь, спасибо за макрос
вопрос: а если адреса получателей расположены в диапазоне ячеек (A1:A20)
Все файлы откуда? со всего компа? 🙂
Макрос поиска всех файлов в папке по расширению есть здесь:
http://excelvba.ru/code/FilenamesCollection
находите все файлы нужные, и в цикле прикрепляете их к письму
примерно так код будет выглядеть (на забудьте под макросом добавить код функции GetAllFileNamesUsingFSO из статьи по ссылке)
Подскажите пожалуйста а как сделать что бы В письмо будет вкладываться все файлы с расширениями .pdf, .htm, а также файлы у которых нет расширения ( определял по отсутствию точки в их названии.
Олег, сформируйте шаблон письма в формате HTML, и вставьте в HTML-код тег img, ссылающийся на вашу картинку в интернете
(картинку можно разместить на любом сайте, — лишь бы ссылка на картинку была прямая и постоянная)
Внедрить картинку в тело письма — тоже можно, но код очень сложный (я сам этого не делал ни разу, и не планирую)
Насколько я понял из поиска по интернету в Outlook 2007-2010 данная функция не поддерживается. Отправьте письмо через веб-доступ к почтовому ящику или через другой почтовый клиент.
Сегодня предновогоднее время. Подскажите пожалуйста, каким образом в письме Microsoft Outlook отправить .gif открытку, чтобы при открытии письма клиенты не нажимали ни какие ссылки, а видели уже открывшуюся анимированную открытку?
Доброе время суток! Прошу помочь справить функцию (позволяет отправлять без использования сторонних почтовых программ (типа Outlook, который в свою очередь требует подтверждать отправку письма) по E-Mail активный / открытый в Excell Лист без запроса на подтверждение отправки.
Проблема вот в чем: не могу заставить сохранять форматирование текста согласно шаблона (листа в экселе).
Прошу исправить.
Заранее благодарен.
Sub ЕмейлЭтотЛистВТеле(ByVal Строка As Integer)
‘для работы необходимо подключить библиотеку "Microsoft CDO for Windows200 Library" в редакторе макросов Tool –> References
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1
Set Flds = iConf.Fields
Dim rng As Range
Set rng = Nothing
Set rng = ActiveSheet.UsedRange
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "mail@mail.ru"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.mail.ru"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Update
End With
With iMsg
Set .Configuration = iConf
.BodyPart.Charset = "koi8-r"
.To = Sheets("Лист1").Cells(Строка, 14) ‘MailTo
‘.CC = ""
‘.BCC = ""
.From = "Почтальон"
.Subject = "тема письма"
.HTMLBody = RangetoHTML(rng) ‘.TextBody = strbody
‘ If Len(MailAttachment) > 0 Then .AddAttachment MailAttachment
.Send
End With
End Sub
Function RangetoHTML(rng As Range)
‘ Changed by Ron de Bruin 28-Oct-2006
‘ Working in Office 2000-2013
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
‘Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
‘Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
‘Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
‘Close TempWB
TempWB.Close savechanges:=False
‘Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
Блог о программе Microsoft Excel: приемы, хитрости, секреты, трюки
Excel позволяет создавать диаграммы высокого качества, работать с огромным количеством данных, обрабатывать картинки, блок-схемы и многое другое. И даже если вам и этого не достаточно, можно использовать Excel для автоматической отправки писем с помощью встроенного VBA редактора.
Данная статья описывает три способа отправки писем с помощью VBA в Excel. Вы можете скачать файл с примером отправки email с помощью VBA в Excel.
Отправить письмо в Excel с помощью VBA
Один из самых простых способов для автоматизации отправки почты с Excel заключается в вызове функции Create («ObjectOutlook.Application»). Данная функция возвращающает ссылку на ActiveX объект (в данном случает приложение Outlook), которое затем используется для создания и отправки электронной почты.
Чтобы проверить данный способ в работе, скопируйте и вставьте код ниже в VB редактор.
В качестве напоминания: Когда вы пытаетесь отправить письмо вышеуказанным способом, система безопасности будет выдавать каждый раз предупреждающее окно, в котором будет говориться о том, что Программа пытается отправить сообщение от вашего имени… и возможности обойти этот шаг нет.
К счастью, существует еще два способа, с помощью которых данный вопрос может быть решен: первый – через использование CDO, второй – имитирующий использование событий нажатий клавиш клавиатуры.
Отправить письмо в Excel с помощью CDO
Что такое CDO? CDO является библиотекой объектов, которая предоставляет интерфейс Messaging Application Programming Interface (MAPI). CDO позволяет манипулировать обменом данных, и отправлять и получать сообщения.
Использование CDO может быть предпочтительно в случаях, когда вы хотите предотвратить появление вплывающих окон безопасности Программа пытается отправить сообщение от вашего имени… и следовательно, предотвратить задержку отправки сообщения.
В нашем примере мы используем функцию CreateObject («CDO.Message»). Важно отметить, что необходимо правильно установить конфигурацию SMTP сервера, чтобы не допустить появления ошибок Run-time error 2147220973(80040213) или sendUsing configuration value is invalid. Пример ниже настроен на отправку сообщений через почту Google (Gmail). Для других почтовых серверов, вам потребуется ввести свои значения SMTP-сервера и SMTP-порта.
Обратите внимание, чтобы воспользоваться данным методом вам необходимо подключить библиотеку CDO в редакторе макросов Tool –> References.
Отправить письмо в Excel с помощью Send Keys
Другой способ отправки email с помощью Excel – использование команды ShellExecute, которая выполняет любую программу в VBA. Команда ShellExecute используется для загрузки документа с соответствующей программой. По сути, вы создаете объект String (текстовые данные) и передаете его в качестве параметра для функции ShellExecute. Остальная часть операций выполняется в окнах. Автоматически определяется, какая программа связана с данным типом документа и используется для загрузки документа. Вы можете использовать функцию ShellExecute, чтобы открыть Internet Explorer, Word, Paint и множество других приложений. В коде ниже используется задержка в три секунды, чтобы убедиться, что отправляемое письмо корректно и для возможности предотвратить отправку, если вы вдруг нашли какие-нибудь недочеты.