Как отправить письмо из Excel?
Прежде чем начать читать статью прошу принять к сведению объявление:
используйте СВОИ АДРЕСА ЭЛ.ПОЧТЫ при тестировании кодов . Не надо отсылать письма на указанные в статье e-mail адреса- это все приходит мне на почту. Помимо этого Вы сами не сможете понять работает или нет, т.к. письма придут мне, а не Вам.
Спасибо за понимание
P.S. А если написанное выше Вы все же проигнорировали и отправили письмо на мои адреса электронной почты - это означает, что Вы соглашаетесь с тем, что вся информация внутри письма, включая вложения, может быть использована мной без ограничений в личных целях.
- Отправка через меню Excel
- Простая отправка книги через VBA без Outlook
- Отправка писем через VBA при помощи Outlook(с вложениями)
- Отправить письма через Outlook с картинкой в теле письма
- Массовая рассылка писем по адресам при помощи Outlook
- Отправка сообщения без использования Outlook - используем CDO
Отправить письмо из Excel можно несколькими способами, в том числе и через написание кода в VBA.
Отправку без кода осуществить достаточно просто:
- Excel 2003: Файл
(File) -Отправить(Send To) -Сообщение(Mail Recipient)
и выбрать способ отправки:- Сообщение
(Mail Recipient) - создается сообщение в программе по умолчанию для отправки электронных писем - Сообщение (для ознакомления)
(Mail Recipient for Review) - вполне интересный вариант. Перед отправкой для книги включается отслеживание изменений(Сервис(Tools) -Исправления(Track changes) ). Можно воспользоваться этим методом, чтобы отправить получателю для внесения им изменений, а после отследить их(Сервис -Исправления -Выделить исправления(Highlight changes) ) - Сообщение (как вложение)
(Mail Recipient as attachment) - создается сообщение в программе по умолчанию для отправки электронных писем, в которое вложением вкладывается активная книга целиком - По маршруту
(Routing Recipient) - практически тоже самое, что и Сообщение (для ознакомления)(Mail Recipient for Review) с той разницей, что письмо с вложением пересылается как эстафета от одного получателя к другому. После этого так же можно отследить изменения, внесенные каждым пользователем - Папка Exchange
(Exchange folder) - активная книга автоматически сохраняется в заданную папку общего сервера Microsoft Exchange. Доступ к этой книге будет открыт всем участникам рабочей группы - Факс пользователю службы факсов интернета
(Fax) - отправляет содержимое книги по факсу указанным получателям. Для использования данной возможности должна быть установлена служба факсов
- Сообщение
- Excel 2007: Кнопка Офис -Отправить
(Send) -Сообщение(E-mail) - Excel 2010: Файл
(File) -Сохранить и отправить(Save & Send) -Отправить(Send Using E-mail) - Как вложение
(Send as attachment) - будет автоматически запущена почтовая программа по умолчанию и создано новое письмо, в которое уже будет вложен файл книги, из которой была вызвана команда - Как ссылку
(Send link) - доступно, только если файл находится на сетевом ресурсе. После нажатия будет создано новое письмо в почтовой программе по умолчанию, в тело которого будет вставлена ссылка на книгу - Как PDF
(Send as PDF) - файл будет автоматически сохранен в формате PDF, далее будет создано новое письмо в почтовой программе по умолчанию и файл PDF будет вставлен в письмо - Как XPS
(Send as XPS) - файл будет автоматически сохранен в формате PDF, далее будет создано новое письмо в почтовой программе по умолчанию и файл PDF будет вставлен в письмо - Отправить как факс через интернет
(Send as internet fax) - если у вас на ПК установлена служба работы с факсами и есть возможность отправлять и получать факсы на ПК - то данная команда отправит данные активного листа файла как факс
Далее выбирается способ отправки:
Описанные выше действия можно выполнить так же кодом(так же будет использоваться программа, установленная по умолчанию для отправки писем):
Sub SendMailStandart() ActiveWorkbook.SendMail "mail1@excel-vba.ru", "Тема письма" End Sub |
Также можно указать несколько получателей:
Sub SendMailStandart_MassRecipients() ActiveWorkbook.SendMail Array("mail1@excel-vba.ru", "mail2@excel-vba.ru"), "Тема письма" End Sub |
Внутри скобок Array можно в кавычках через запятую указать достаточное количество получателей.
Данный метод универсален, но работает только с активным файлом. Нельзя выбрать файл с диска и отправить как вложение. Кроме того, нельзя отправить более одного файла разом и указать текст письма.
Поэтому очень часто на форумах возникает вопрос как отправить письмо из Excel кодом с указанием темы, текста и вложения.
Есть несколько вариантов:
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 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 'раскомментировать строку, если в Outlook несколько учетных записей и нужно подключиться к конкретной(только если Outlook закрыть) ' [параметры]: Session.Logon "имя профиля","пароль",[показывать окно выбора профиля], [запускать в новой сессии] 'objOutlookApp.Session.Logon "profile","1234",False, True 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 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.) 'добавляем вложение, если файл по указанному пути существует(dir проверяет это) If sAttachment <> "" Then If Dir(sAttachment, 16) <> "" Then .Attachments.Add sAttachment 'просто вложение 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName End If End If .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра End With Set objOutlookApp = Nothing: Set objMail = Nothing Application.ScreenUpdating = True End Sub |
Этот код отправляет одно письмо и одно вложение за раз. Но если несколько раз вызвать метод .Attachments.Add, то можно добавить еще файлы:
.Attachments.Add "C:\Temp\Книга1.xlsx" .Attachments.Add "C:\Temp\Книга2.xlsx" .Attachments.Add "C:\Documents\Report.rar" |
Строка:
objOutlookApp.Session.Logon "user","1234",False, True |
имеет особое значение. По сути она нужна только в тех случаях, когда в Outlook настроено несколько профилей(не путать с учетными записями) и запускать нужно от конкретного. Если профиль только один или не указан, то Outlook запускается с профилем по умолчанию. Для этого строку нужно записать без параметров(так же можно записать эту строку, если Outlook при попытке создания письма выдает ошибку профиля):
objOutlookApp.Session.Logon |
Важно помнить: пути для файлов в качестве вложений должны содержать полный путь до файла, включая его имя и расширение:C:\Documents\Report.rar . При указании только имениReport.rar или пути без расширения (C:\Documents\Report ) ошибки не будет, но вложения не будут помещены в сообщения и адресату отправится письмо без вложений.
Этот код создает сообщение, но есть маленький нюанс - если в Outlook настроено добавление подписей в новые сообщения - то созданные кодом VBA письма игнорирует эту настройку(особенность Outlook, так назовем). Поэтому, если необходимо отправлять письма с подписью, то ознакомьтесь со статьей: Вставить в письмо подпись из Outlook через VBA
В этой же статье можно посмотреть пример составления письма с форматированным текстом.
Sub Send_Mail_With_Picture() Dim objOutlookApp As Object, objMail As Object Dim sTo As String, sSubject As String, sBody As String, sAttachment As String, sPicture As String 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 "user","1234",False, True 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) sPicture = "C:\Документы\Изображения\Excel_vba_ru.png" 'если надо вставить в письмо картинку 'создаем сообщение With objMail .To = sTo 'адрес получателя .CC = "" 'адрес для копии .BCC = "" 'адрес для скрытой копии .Subject = sSubject 'тема сообщения ' .Body = sBody 'текст сообщения без форматирования .HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.) 'чтобы картинка была видна внутри сообщения - надо её сначала добавить как вложение 'если картинка по указанному пути существует(dir проверяет это) If Dir(sPicture, 16) <> "" Then If Dir(sPicture, 16) <> "" Then .Attachments.Add sPicture 'теперь вставляем код картинки .HTMLBody = .HTMLBody & "<p>Картинка в письме</p>" & "<img src=cid:" & Replace(Dir(sPicture, 16), " ", "%20") & ">" ' & " height=240 width=180>" '" height=240 width=180>" - если нужны размеры картинки End If End If 'добавляем вложение, если файл по указанному пути существует(dir проверяет это) If sAttachment <> "" Then If Dir(sAttachment, 16) <> "" Then .Attachments.Add sAttachment 'просто вложение End If End If .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра End With Set objOutlookApp = Nothing: Set objMail = Nothing Application.ScreenUpdating = True End Sub |
Этот код отправляет одно письмо и вставляет одну картинку. За это отвечает строка
"<img src=cid:" & Replace(Dir(sPicture, 16), " ", "%20") & ">" |
Если картинку надо вложить с заранее указанными размерами, то строка будет выглядеть так:
"<img src=cid:" & Replace(Dir(sPicture, 16), " ", "%20") & " height=240 width=180>" 'height - высота 'width - ширина |
Если надо добавить несколько картинок, то метод
Важно помнить: пути для картинок должны содержать полный путь до файла, включая его имя и расширение:C:\Документы\Изображения\Excel_vba_ru.png . При указании только имениExcel_vba_ru.png или пути без расширения (C:\Документы\Изображения\Excel_vba_ru ) ошибки не будет, но картинка не будет вставлена, а вместо неё скорее всего будет текст "Ошибка загрузки картинки!" или пустой квадрат вместо реальной картинки.
Так же можно сделать нечто вроде рассылки, организовав цикл по ячейкам. Предположим, что в столбце А записаны адреса, в столбце В тема, в столбце С текст сообщения, в столбце D путь к вложениям:
Тогда можно применить следующий код:
Sub Send_Mail_Mass() Dim objOutlookApp As Object, objMail As Object Dim sTo As String, sSubject As String, sBody As String, sAttachment As String Dim lr As Long, lLastR As Long 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 'произошла ошибка создания объекта - выход If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub 'objOutlookApp.Session.Logon "user","1234",False, True lLastR = Cells(Rows.Count, 1).End(xlUp).Row 'цикл от второй строки(начало данных с адресами) до последней ячейки таблицы For lr = 2 To lLastR Set objMail = objOutlookApp.CreateItem(0) 'создаем новое сообщение 'создаем сообщение With objMail .to = Cells(lr, 1).Value 'адрес получателя .Subject = Cells(lr, 2).Value 'тема сообщения .Body = Cells(lr, 3).Value 'текст сообщения 'вложение(если ячейка не пустая и путь к файлу указан правильно) If Cells(lr, 4).Value <> "" Then If Dir(Cells(lr, 4).Value, 16) <> "" Then .Attachments.Add Cells(lr, 4).Value End If End If .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра End With Next lr Set objOutlookApp = Nothing: Set objMail = Nothing Application.ScreenUpdating = True End Sub |
Массовая рассылка писем через Outlook.xls (60,0 KiB, 7 458 скачиваний)
При использовании этих кодов есть один недостаток: очень часто при программной отправке писем Outlook выдает окно с запросом подтверждения отправки. Сообщение может быть трех видов:
- Программа пытается получить доступ к адресам электронной почты, хранящимся в Outlook. Если вы этого не ожидаете, нажмите кнопку "Запретить" и проверьте наличие последних обновлений для антивирусной программы.
- Программа пытается отправить сообщение от вашего имени. Если вы этого не ожидаете, нажмите кнопку "Запретить" и проверьте наличие последних обновлений для антивирусной программы.
- Программа пытается выполнить действие, которое может привести к отправке сообщения от вашего имени. Если вы этого не ожидаете, нажмите кнопку "Запретить" и проверьте наличие последних обновлений для антивирусной программы
Чтобы при программной отправке данных сообщений не появлялось, в версиях Outlook, начиная с 2007 можно отключить его настройками безопасности:
- Outlook 2007: Меню-Параметры-Центр управления безопасностью-Программный доступ-установить Никогда не предупреждать о подозрительной активности (не рекомендуется)
- Outlook 2010 и выше: Файл-Параметры-Центр управления безопасностью-Программный доступ-установить Никогда не предупреждать о подозрительной активности (не рекомендуется)
ВАЖНО: Если компьютер управляется администратором Microsoft Exchange или Microsoft Windows Active Directory Domain Services и администратором в качестве параметров по умолчанию установлен запрет на внесение изменений в параметры безопасности пользователями, возможность изменения данных настроек безопасности программного доступа будет недоступна.
Важно: сам код рассылки не имеет никаких ограничений по числу отправляемых сообщений. Но различные почтовые серверы могут устанавливать свои лимиты. Например, Gmail и Yandex могут заблокировать email, с которого ведется рассылка, если общее количество отправленных сообщений превышает 100 штук в день. Поэтому производить важные массовые рассылки рекомендуется с собственного SMTP-сервера.
Но так же при отправке файлов и писем часто необходимо не привязываться к конкретной почтовой программе. Ведь далеко не все ставят Outlook. Многие используют иные почтовые программы, например TheBat.
Option Explicit Sub Send_Mail() Const CDO_Cnf = "http://schemas.microsoft.com/cdo/configuration/" Dim oCDOCnf As Object, oCDOMsg As Object Dim SMTPserver As String, sUsername As String, sPass As String, sMsg As String Dim sTo As String, sFrom As String, sSubject As String, sBody As String, sAttachment As String On Error Resume Next 'sFrom – как правило совпадает с sUsername SMTPserver = "smtp.yandex.ru" ' SMTPServer: для Mail.ru "smtp.mail.ru"; для Яндекса "smtp.yandex.ru"; для Рамблера "mail.rambler.ru" sUsername = "YourMail@mail.ru" ' Учетная запись на сервере sPass = "1234" ' Пароль к почтовому аккаунту If Len(SMTPserver) = 0 Then MsgBox "Не указан SMTP сервер", vbInformation, "www.Excel-VBA.ru": Exit Sub If Len(sUsername) = 0 Then MsgBox "Не указана учетная запись", vbInformation, "www.Excel-VBA.ru": Exit Sub If Len(sPass) = 0 Then MsgBox "Не указан пароль", vbInformation, "www.Excel-VBA.ru": Exit Sub sTo = "AddressTo@mail.ru" 'Кому sFrom = "YourMail@yandex.ru" 'От кого sSubject = "Автоотправка" 'Тема письма sBody = "Привет от Excel-VBA" 'Текст письма sAttachment = "C:/Temp/Книга1.xls" 'Вложение(полный путь к файлу) 'Назначаем конфигурацию CDO Set oCDOCnf = CreateObject("CDO.Configuration") With oCDOCnf.Fields .Item(CDO_Cnf & "sendusing") = 2 .Item(CDO_Cnf & "smtpauthenticate") = 1 .Item(CDO_Cnf & "smtpserver") = SMTPserver 'если необходимо указать SSL '.Item(CDO_Cnf & "smtpserverport") = 465 'для Яндекса и Gmail 465 '.Item(CDO_Cnf & "smtpusessl") = True '===================================== .Item(CDO_Cnf & "sendusername") = sUsername .Item(CDO_Cnf & "sendpassword") = sPass .Update End With 'Создаем сообщение Set oCDOMsg = CreateObject("CDO.Message") With oCDOMsg Set .Configuration = oCDOCnf .BodyPart.Charset = "koi8-r" .From = sFrom .To = sTo .Subject = sSubject .TextBody = sBody 'Проверка наличия файла по указанному пути If Len(sAttachment) > 0 Then If Dir(sAttachment, 16) <> "" Then .AddAttachment sAttachment End If End If .Send End With Select Case Err.Number Case -2147220973: sMsg = "Нет доступа к Интернет" Case -2147220975: sMsg = "Отказ сервера SMTP" Case 0: sMsg = "Письмо отправлено" Case Else: sMsg = "Ошибка номер: " & Err.Number & vbNewline & "Описание ошибки: " & Err.Description End Select MsgBox sMsg, vbInformation, "www.Excel-VBA.ru" Set oCDOMsg = Nothing: Set oCDOCnf = Nothing End Sub |
Данный код отправляет письмо, используя объект
SMTPserver - Каждый из приведенных выше сервисов имеет свой сервер для отправки сообщений(его можно посмотреть на сайте сервиса). В комментариях к коду я написал три самых распространенных, но если Вы используете какой-то другой, то просто посмотрите на его сайте настройки дляOutlook и отыщите тот параметр, который отвечает заSMTPserver .sUsername - это Ваш логин для входа в почтовый сервис. Думаю тут все понятно. Единственный момент - обязательно указывать e-mail именно в полном виде - , даже если для входа на сервис через браузер Вы используете только первую часть записи(YourMail). Если необходимо подставить в качестве отправителя псевдоним(чтобы получатель видел не просто адрес, а ассоциированное имя учетной записи), то указывать надо именно в формате псевдонима:YourMail@mail.ru sFrom = "Excel-vba <YourMail@yandex.ru>"
Excel-vba - и есть псевдоним. А сам адрес должен указываться между знаками <>sPass - пароль доступа к Вашей учетной записи, который Вы используете для входа в почту.
Это основные моменты. Поля
Так же стоит учесть пару важных моментов: если на почтовом сервере используется шифрование, то необходимо раскомментировать(убрать знак апострофа) эти строки:
.Item(CDO_Cnf & "smtpserverport") = 465 .Item(CDO_Cnf & "smtpusessl") |
Иначе вместо отправки письма получим ошибку "Отказ сервера SMTP". Серверы Яндекс и Gmail требуют шифрования, а значит для них указанные выше строки должны быть активированы(т.е. раскомментированы). Номер порта указывается в описании настроек сервера и для каждого сервера может быть своим, поэтому если с указанием приведенного в коде порта(
Чтобы использовать данный код вы можете либо просто скопировать его прямо со страницы, либо скачать файл. В файле программа немного упрощена к использованию - в ячейки листа вам необходимо будет внести поля: Кому(sTo), От кого(sFrom),Тема письма(sSubject), Текст письма(sBody) и Вложение(sAttachment) и выбрать SMTPserver. SMTPserver выбирается из выпадающего списка. Сам список является динамическим и расположен на листе "Settinngs". Там же расположены поля Учетной записи и Пароль, которые автоматически подставляются в необходимые поля на листе "Отправка". Т.к. список динамический Вы можете просто добавлять к уже имеющимся новые сервисы и потом просто выбирать их из списка. Так же в файле есть еще одна возможность - выбрать файл. Для этого надо просто нажать на кнопку и выбрать файл.
Массовая рассылка писем через CDO - без Outlook.xls (64,0 KiB, 7 805 скачиваний)
Ввиду все более участившихся вопросов о том, как добавить к тексту письма картинку именно через CDO - описываю как это можно сделать. Я приведу лишь самый главный кусок кода - создание непосредственно сообщения. Весь остальной код остается таким же, как приведен выше.
With oCDOMsg Set .Configuration = oCDOCnf .From = sFrom .BodyPart.Charset = "windows-1251" .To = sTo .Subject = sSubject Set objbp = oCDOMsg.AddRelatedBodyPart("C:\Документы\Изображения\11.jpg", "11.jpg", 1) objbp.Fields.Item("urn:schemas:mailheader:Content-ID") = "<11.jpg>" objbp.Fields.Update If Len(sAttachment) > 0 Then If Dir(sAttachment, 16) <> "" Then .AddAttachment sAttachment End If End If 'для вложения картинки письмо лучше формировать в формате HTML .HTMLBody = "<img src=""11.jpg""><br />" & sBody .Send End With |
Самый главный момент:
внутри же самого письма в том месте, где должна отображаться картинки надо записать:
"<img src=""11.jpg"">" |
в приведенном выше коде картинка вставляется в самом начале письма и после неё так же добавляется перенос на новую строку при помощи тэга
<br /> |
Также см.:
Отправка листа/книги по почте
Вставить в письмо подпись из Outlook через VBA
Вставить в письмо Outlook таблицу Excel с форматированием
Сохранить вложения из Outlook в указанную папку
Как отправить письмо от другой учетной записи Outlook
Статья помогла? Поделись ссылкой с друзьями!
Поиск по меткам
Access apple watch Multex Power Query и Power BI VBA управление кодами Бесплатные надстройки Дата и время Записки ИП Надстройки Печать Политика Конфиденциальности Почта Программы Работа с приложениями Разработка приложений Росстат Тренинги и вебинары Финансовые Форматирование Функции Excel акции MulTEx ссылки статистикаКомментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум
Добрый день.
В код "Массовая рассылка писем по адресам" как добавить:
1. Нескольких получателей ("To") ['предполагаю, что их адреса нужно просто поместить в ячейку Excel, отделяя точкой с запятой]
2. Получателя/получателей копии письма ("Сс")
3. Возможность выбора адреса, с которого будет произведена отправка письма для каждой строки в Excel? ['предполагаю, что нужно добавить еще один столбец Excel, где прописать этот адрес для каждой строки. Если так, то пусть это будет первый столбец].
С уважением
Добрый день, Дмитрий. При работе с макросом отправки почты с помощью CDO я обнаружил следующую особенность. Когда отправка идёт с адреса "username@gmail.com" (т.е. через Гугл-почту), то отправленное письмо автоматически сохраняется в папке "Отправленные" Гугл-почты. Если же отправлять письмо с адреса "username@domain.ru" где домен делегирован на Яндексе и почта, соответственно, тоже привязана к Яндексу, то отправленное письмо в папке "Отправленные" отсутствует. С чем, по Вашему мнению, может быть связана такая разница в работе почтовых сервисов и возможно ли получить на Яндексе тот же результат, что и на Гугле, раз уж такая возможность в принципе существует?
mikeole, CDO тут по сути никак не влияет и следовательно через код это не настроить. Все зависит от самого почтового сервера. В данном случае Gmail сохраняет такие письма, а Яндекс нет. Да и не сохранял никогда.
Дмитрий, подскажите, а можно ли в кодюлю зашить еще выбор "от кого"?
У нас в корпоративном оутлуке приклеено несколько адресов, с которых отправлять можно. Или он только по умолчанию берет адрес оутлука?
Спасибо за код. Я его успешно использовал для посылки минуя outlook
Все проходит нормально, когда я внутри домена .ru.
когда пытался отправить с mail.ru на gmail.com. Почта на приходит.
Если сможете помочь буду Вам благодарен.
Не смогу, т.к. от Вас ноль информации. Для начала надо ознакомиться с требованиями и ограничениями настроек на самом почтовом сервере. Как правило в случае с CDO ошибки именно в настройках(неправильно указан порт, отключено шифрование когда оно необходимо и т.п.).
Здравствуйте.
В варианте «ОТПРАВИТЬ ПИСЬМО ЧЕРЕЗ OUTLOOK КОДОМ VBA», когда OUTLOOK закрыт, спрашивает выбор конфигурации и предлагает выбрать Outlook. Я делаю заявку для сотрудников и мне хотелось бы, чтобы они совершали по минимуму телодвижений, можно ли как нибудь прописать в VBA выбор по умолчанию Outlook или другим способом убрать появление этого окна?
Артем, из VBA никак нельзя. Обратитесь к системным администраторам компании, чтобы они сделали настройку конфигурации Outlook для сотрудников. Если все настроено верно, то ничего спрашиваться не должно.
Выбор конфигурации вызывает вот эта строчка «objOutlookApp.Session.Logon»
Нашёл другой код, он при закрытом outlook ничего не выводит и спокойно отправляет. Может Вам будет интересно.
Sub Отправить_Письмо_из_Outlook()
'отправляем письмо без вложений
res = SendEmailUsingOutlook("mr.idea@list.ru", "Текст письма 1", "Тема письма 1")
If res Then Debug.Print "Письмо 1 отправлено успешно" Else Debug.Print "Ошибка отправки"
'отправляем письмо с 1 вложением
attach$ = ThisWorkbook.FullName ' прикрепляем текущий файл Excel
res = SendEmailUsingOutlook("mr.idea@list.ru", "Текст письма 2", "Тема письма 2", attach$)
If res Then Debug.Print "Письмо 2 отправлено успешно" Else Debug.Print "Ошибка отправки"
'отправляем письмо с несколькими вложениями
Dim coll As New Collection ' заносим в коллекцию список прикрепляемых файлов
'coll.Add "C:\Documents and Settings\Admin\Рабочий стол\Tyres.jpg"
'coll.Add "C:\Documents and Settings\Admin\Рабочий стол\calc.xls"
coll.Add ThisWorkbook.FullName ' прикрепляем текущий файл Excel
res = SendEmailUsingOutlook("mr.idea@list.ru", "Текст письма 3", "Тема письма 3", coll)
If res Then Debug.Print "Письмо 3 отправлено успешно" Else Debug.Print "Ошибка отправки"
End Sub
Function SendEmailUsingOutlook(ByVal Email$, ByVal MailText$, Optional ByVal Subject$ = "", _
Optional ByVal AttachFilename As Variant) As Boolean
' функция производит отправку письма с заданной темой и текстом на адрес Email
' с почтового ящика, настроенного в Outlook для отправки писем "по-умолчанию"
' Если задан параметр AttachFilename, к отправляемому письму прикрепляется файл (файлы)
On Error Resume Next: Err.Clear
Dim OA As Object: Set OA = CreateObject("Outlook.Application")
If OA Is Nothing Then MsgBox "Не удалось запустить OUTLOOK для отправки почты", vbCritical: Exit Function
With OA.CreateItem(0) 'создаем новое сообщение
.To = Email$: .Subject = Subject$: .Body = MailText$
If VarType(AttachFilename) = vbString Then .Attachments.Add AttachFilename
If VarType(AttachFilename) = vbObject Then ' AttachFilename as Collection
For Each file In AttachFilename: .Attachments.Add file: Next
End If
For i = 1 To 100: DoEvents: Next ' без паузы не отправляются письма без вложений
Err.Clear: .Send
SendEmailUsingOutlook = Err = 0
End With
Set OutApp = Nothing
End Function
Попробовал без этой строчки «objOutlookApp.Session.Logon» заработало всё без вывода выбора конфигурации.
Можете пояснить, зачем она нужна?
Здравствуйте, Дмитрий!
Я скачал файл Tips_Macro_SendMailCDO.xls, заполнил поля и при отправке получил сообщение "Ошибка -2147220974. Транспорт потерял связь с сервером".
Дмитрий, можете ли Вы подсказать, почему возникает эта ошибка и как ее исправить?
Заранее благодарю за ответ.
С уважением,
Сергей
Дмитрий, добрый день..
Скачал ваш файл Tips_Macro_SendMailCDO.xls Все работает отлично, почта отправляется и принимается, но после выполнения макроса возникает проблема: Excel начинает вести себя странно, а именно - периодически перестает переключаться между листами, или книгами, не удается пользоваться всем функционалом Ленты, в частности не получается менять цвет ячеек или шрифта. Причем эта проблема на разных компьютерах проявляется по-разному - на одном компе нельзя закрасить ячейку в принципе, на другом нельзя только выбирать новые цвета из палитры, а базовые применить можно. После закрытия и открытия файла, все работает как надо. Использую Excel 2013. В чем может быть проблема и как ее решить? (Application.ScreenUpdating = True не помогает, да и не причем это тут).
Boris13, не думаю, что дело в коде. Скорее дело в самом файле(в какой-то момент он мог поломаться или неверно считаться изначально). Попробуйте создать новый файл с нуля, вставить в него только код. Проверьте его работу.
Дмитрий, все сделал: создал новый и чистый файл, скопировал код из статьи. Проблема не ушла! Да, все работает в плане работоспособности кода, тут вопросов нет, но такое ощущение, что остается незавершенным какой-то процесс, который параллелится и "мешает". Заметил такую особенность, что когда (после отработки макроса) навожу мышкой на палитру цветов (просто не ней нагляднее всего описать "глюк"), и жду секунд 10-15, то происходит "отвисание" и цвет в ячейке поменять можно, но вот с границами ячеек, такое не проходит. Так же "отваливается" переход между окнами VBE и Excel через Alt+Tab (именно между ними, а не между всеми окнами Windows). И это не единственное, что происходит. А у вас таких проблем нет, может быть просто не обращали внимание на это? у меня у одного такое? Такая проблема на любых ПК и как на W7, так и на W10. Excel 2013 Заранее спасибо за ответ!
У меня и многих других подобный код работает без каких-либо проблем. Сам его использовал не раз на Win7(32 и 64) и никаких зависаний и глюков не было. Я бы убедился сначала в том, что нет других надстроек и макросов, которые могли бы запускаться вместе с этим или как-то влиять.
Попробуйте так же отправку через Outlook - если проблема повторится, значит дело точно не в коде. Если нет - вполне возможно, что проблема в самой библиотеке CDO, установленной на ПК.
Дмитрий, спасибо, понял. Буду разбираться дальше. Если найду решение, поделюсь опытом...
Всем доброго дня. Предложил своим использовать вариант "Массовая рассылка писем по адресам". От себя добавил уведомление о доставке и кол-во столбцов для отправки файлов >1. Т.е.
.Attachments.Add Cells(lr, 4).Value 'вложение 1
.Attachments.Add Cells(lr, 5).Value 'вложение 2
.Attachments.Add Cells(lr, 6).Value 'вложение 3
.Attachments.Add Cells(lr, 7).Value 'вложение 4
.OriginatorDeliveryReportRequested = True 'уведомление о доставке письма
Хотя, можно и цикл по столбцам сделать. Только как определить последний заполненный столбец не знаю. Поэтому строки для вложений добавил.
Автору респект. Дал возможность несколько упростить работу. И показать, что насколько я не знаю эксель. :)
Добрый день Дмитрий, спасибо большое что поделились сакральным знанием как сделать массовую рассылку. Скачал ваш файл "Tips_Macro_SendMail_Mass.xls". Естественно при отправке выходит окно с запросом подтверждения и естественно в рамках рабочей организации админы не могут дать разрешение(способ описанный вами).
Нашел следующий способ решения, добавил в ваш код вместо .Send имитацию ENTER:
.Display
Application.Wait (Now + TimeValue("0:00:01"))
Application.SendKeys "^{ENTER}"
Application.SendKeys "{ENTER}"
Но как оказалось данный код отправляет письма почему-то через один. А те что не отправляет остаются висеть открытыми.
Вы не могли бы помочь разобраться почему так происходит и как доработать код чтобы имитация ENTER работала?
ссылка на доработанный мной файл:
https://yadi.sk/i/oXgubc1Z-33sRQ
Спасибо вам большое!
Антон, нет, имитация ENTER не будет нормально работать, как ни делай. Тут проблема как минимум в том, что окно подтверждения может появиться сразу, может через две секунды, может через 4 - зависит от загрузки ПК в том числе. Поэтому сделать 100% рабочий вариант в этом случае не получится. Куда логичнее отправить кодом одно письмо и в появившемся окне выбрать что-то вроде "разрешить на 10 минут". Вроде было такое раньше. А потом уже делать массовую рассылку - за 10 минут должна завершиться.
Спасибо за оперативный ответ. А что вы имеете в виду:
"Куда логичнее отправить кодом одно письмо и в появившемся окне выбрать что-то вроде "разрешить на 10 минут""? при отправке появляется уведомительные сообщение только с тремя кнопками "Разрешить, Запретить Справка", Кнопки "разрешить на 10 минут" нет.
А так, к сожалению, в рабочем варианте почтового клиента никак не получается автоматизировать авторассылку((( Очень надеюсь на вас.
Обратив внимание что при отправке моим способом, сообщения не отправленные как будто переходят на кнопку "кому" вместо "отправить" и остаются выесть. Может можно программным способом перейти на кнопку именно "отправить", а потом уже имитировать Ентер?
Антон, здесь ничего не сделать нормально без доступа к настройкам безопасности. Это защита Outlook от несанкционированного доступа.
А SendKeys, как уже писал - очень нестабильное решение.
Здравствуйте, Дмитрий!
Хотел бы узнать у Вас по рассылке "МАССОВАЯ РАССЫЛКА ПИСЕМ ПО АДРЕСАМ".
Пытаюсь сделать рассылку более универсальной в плане рассылки вложений.
У меня данные начинаются с 3 строки, столбцы с указанием путей к вложениям для рассылки - с 6 столбца.
Сейчас код по рассылке с несколькими вложениями выглядит так:
.Attachments.Add Cells(lr, 6).Value 'вложение 1
.Attachments.Add Cells(lr, 7).Value 'вложение 2
.Attachments.Add Cells(lr, 8).Value 'вложение 3
.Attachments.Add Cells(lr, 9).Value 'вложение 4
.Attachments.Add Cells(lr, 10).Value 'вложение 5
.Attachments.Add Cells(lr, 11).Value 'вложение 6
.Attachments.Add Cells(lr, 12).Value 'вложение 7
.Attachments.Add Cells(lr, 13).Value 'вложение 8
и так далее.
Код работает, всё хорошо.
Но мне бы хотелось циклом проходить по столбцам, то есть сделать код более универсальным.
Dim lLastCol As Long 'задание переменной
lLastCol = Cells(1, Columns.Count).End(xlToLeft).Column 'определение последнего заполненного столбца
А дальше моих знаний не хватает. Не знаю, как вложить еще один цикл внутрь цикла создания писем.
Дмитрий, буду рад любой Вашей подсказке!