Макрос отправки письма из Excel через Outlook

Добрый день.

Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "test@test.ru"
.Subject = "test"
.Body = "test"
.Send
End With

Отправляет все прекрасно.
Но тут появилась необходимость ставить цифровую подпись на письмо.
Подскажите пожалуйста как это сделать.

Подпись имеется в наличии, при ручной отправке все нормально проставляется.
Если поставить опцию подписываться все сообщения, то и письмо отправляемое макросом также уходит подписанным, но хочется подписывать конкретные письма.

Заранее благодарен.

Здравствуйте! Отправляю файл более 20 Мбайт от *******@mail.ru на *******@mail.ru с помощью SendMail выдаёт окно с предупреждением системы безопасности с вопросом разрешить отправку? требуется дополнительно нажимать разрешить, как обойти это обойти? настройки в outlook стоит галочка не предупреждать. программа

Добрый день!
Есть следующий вопрос (см.ниже, взят из интернета):
Нужно из Excel 2010 макросом создавать письмо Outlook, в которое автоматом прикреплялся бы иной файл Excel 2010, размещенный (например) на рабочем столе компьютера. Т.е условно письмо отправляем из файла «А», а прикрепляться к письму должен файл «В».
В интернете нашел следующий макрос, но почему-то файл не цепляется к письму.
В конкретно данном примере есть строка «sAttachment = "C:/Temp/Книга1.xls"», указывающая на месторасположение файла, подлежащего прикреплению к письму.
Я указываю там тот путь, по которому расположен мой файл на компьютере. Например «C:\Users\Алексей\Desktop\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
    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

Добрый день. Спасибо за ответ. Подпись так и сделал, думал есть более изящный вариант, чтобы сохранить форматирование. а Excel понимает язык гипертекста? То есть, можно вских /br и все будет окей?
По второму пункту не понял, похоже я зря не вложил макрос, так было бы понятнее. В каждом письме у меня 2 переменные, почтовый адрес и модель товара. 10 моделей товара для каждого почтового адреса, я хотел чтобы в момент нажатия кнопки модель с этой страницы(каждый товар на отдельной странице в ячейке А2) автоматически вставлялась в середине тела письма. Получается каждое письмо уникальное. Я хотел сделать ссылку на модель товара в теле письма.
Вот макрос:
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 = Sheets("mail").Range("B2").Value 'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value)
sSubject = "у вас закончился товар" 'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value)
sBody = Sheets("mail").Range("C2").Value 'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value)
sAttachment = "C:\Users\dzatsepin\Desktop\Work\retail_internet_price.xlsx" 'Вложение(полный путь к файлу. Можно заменить значением из ячейки - sAttachment = Range("A4").Value)

'создаем сообщение
With objMail
.To = sTo 'адрес получателя
.Subject = sSubject 'тема сообщения
.Body = sBody 'текст сообщения
.Attachments.Add sAttachment
.Send
'.Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
End With
exit_:
Set objOutlookApp = Nothing: Set objMail = Nothing
Application.ScreenUpdating = True
End Sub

Коллеги, добрый день помогите советом, если сможете. Требуется отправить письма клиентам, с определенным текстом. Предположим 10 клиентам отправляю информацию о товаре, предварительно выяснив, что этого товара у них нет. У кого нет тем и отправляю письмо. Сделал картинку напротив каждого клиента со ссылкой на макрос, прописал макрос, вот такой:
Он отправляет приглашение приобрести товар.
Сложность 1. Не вставляется подпись, что нужно добавить в код?
Сложность 2. Товаров - 10. То есть в excel 10 вкладок со списком клиентов и информацией, есть у них товар или нет. Возможно ли обойтись без 100 макросов, а как-то сделать так, чтобы в тело письма попадала ссылка на ячейку с товаром с того листа на котором я нахожусь в данный момент. В итоге получится всего 10 макросов. )Остальной текст универсальный. Буду признателен за совет.

Здравствуйте, я пользуюсь макросом для отправки писем. как его доделать, чтобы можно было отсылать по расписанию. Xxnj,s outlook его сохранял в исходящих, задав время отправки, взятое из ячейки в строке с соответствующим адресатом?
Sub рассылка()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

'создаем новое пустое сообщение в Outlook
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeConstants) 'добавил
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(cell) > 0 Then
Set OutMail = OutApp.CreateItem(0)
On Error GoTo cleanup
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
'заполняем его адрес, тему и т.д.
With OutMail
.To = cell.Value 'Range("A2:A5").Value
.Subject = Range("B2").Value
.Body = Range("C2").Value
.BCC = Range("D2")
.Attachments.Add Range("D2").Value
'вместо Send можно использовать Display, чтобы посмотреть сообщение перед отправкой
.Display
End With

Скажите пожалуйста! Возможно ли дописать макрос так чтобы ecxel брал определённый файл из папки, который появляется в указанное время отправлял в указанное время, циклическое?

Что делать после того, как был прописан макрос? office 2010

Подскажите пожалуйста, где прописывать макрос? Я использую outlook

Спасибо большое работает как надо- низкий паклон ! если Вас не затруднит не могли бы подсказать как задать имя сохраняющемся листу например из UserForm1.TextBox1.Value

спасибо за оперативный ответ!

ThisWorkbook.Sheets("test").Copy
attach$ = ThisWorkbook.FullName ' прикрепляем текущий файл Excel
res = SendEmailUsingOutlook("name@domain.ru", "Текст письма 2", "Тема письма 2", attach$)
If res Then Debug.Print "Письмо 2 отправлено успешно" Else Debug.Print "Ошибка отправки"

выдает ошибку при попытке прикрепить скопированный лист?!((

подскажите пожалуйста а как сделать что бы прикладывал определенный лист ?

Здравствуйте, с отправкой писем через лук из екселя проблем не возникло, спасибо вам, но сейчас возник вопрос, как отправить по автомату письмо от определенного адресата(у пользователя на почте две учетки, нужно выбрать в коде второстепенную).
Ставил в коде ".From = a@a.ru" - критует.

Добрый день.
Не получается поставить адресатов в поле "Копия",
.ToCС = не работает.
Заранее благодарю.
Спасибо огромное за пример, очень пригодился!!!!

Да спасибо, так и заменил, что-то сразу не сообразил, где и что он выводит))

Добрый день, попробовал использовать предложенный макрос,
If res Then Debug.Print "Письмо 2 отправлено успешно" Else Debug.Print "Ошибка отправки"
- не выводит никаких сообщений, в чем может быть проблема? может заменить на "msbox" как то?

Большое спасибо.

А если нужно отправить нескольким адресатам, как нужно изменить программу?

Добрый день!
Есть ключевой носитель Rutoken. Соответственно в Outlook есть кнопочки как включить электронную подпись и шифрование с помощью ключевого носителя.
Вопрос - как это включить в макросе, чтоб письмо отправлялось подписанным?

Добрый день! Спасибо за прекрасный пример отправки почтовых сообщений с помощью Outlook.
У меня пример заработал, но есть одно "но": при отправке писем Outlook выводит предупреждающее сообщение о том, что сторонняя программа пытается от вашего имени отправить сообщение. В этом случае от пользователя требуется кликнуть на кнопку в этом диалоговом окне, чтобы разрешить либо запретить оправку письма.
Это не очень удобно, если надо оправлять письма автоматически в заданное время без участия пользователя.
Подскажите, пожалуйста, как можно без участия пользователя нажать кнопку в этом диалоге, чтобы разрешить отправку письма, либо сделать так, чтобы это окно не появлялось, а письмо отправлялось.
Заранее спасибо!

В дополнение:
сейчас я реализовал отправку писем через html. То есть всю подпись сделал в html, изображение через cid и приложение и так далее, в принципе меня все устраивает. Подключая к письму подпись через Activedocument.content (подключается подпись по умолчанию) не смог вставить туда текст письма.
Может быть есть возможность сделать что-то вроде:
.htmlBody = MailText$ & Activedocument.content ( при таком варианте подключается только подпись, что бы я не включил в переменную MailText) ?

Здравствуйте!
Подскажите, пожалуйста, как использовать в письме готовую подпись, которая хранится в outlook? Я изменил в функции
.Body = MailText$
на
.htmlBody = MailText$
Теги теперь понимаются, а вот как создать письмо с подписью - не знаю.
Вообще, также изменен и бланк, то есть шрифты настроены под общий стиль, при создании нового письма в outlook этот бланк подключается, возможно ли такое сделать из макроса?

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

Sub Îòïðàâèòü_Ïèñüìî_èç_Outlook()
x = 1
Do While Cells(x, 1) <> ""

res = SendEmailUsingOutlook(Cells(x, 2), Cells(x, 3) + " " + Cells(x, 1), Cells(x, 6), Cells(x, 7).Value)
If res Then Debug.Print "Ïèñüìî 3 îòïðàâëåíî óñïåøíî" Else Debug.Print "Îøèáêà îòïðàâêè"
x = x + 1
Loop

End Sub

а вот как прикрепить еще одно вложение не знаю.. коллекцией не получается, а AttachFileName более одного значения не принимает. посоветуйте что-нибудь?

разобрался с циклами, но никак не могу понять как в циклах используя cells прикреплять второе вложение ссылка на которое записана в соседней ячейке.

Замечательная вещь!!!
не подскажете как правильно дописать макрос, что бы формировались письма для каждого из ста адресата в отдельности, данные по которым находятся в одной таблице?
Например первому адресату соответствует
почтовый адрес в ячейке А1, Текс письма в ячейке В1, Тема письма в ячейке С1, и ссылка на вложение в ячейке D1.
второму адресату соответствует
почтовый адрес в ячейке А2, Текс письма в ячейке В2, Тема письма в ячейке С2, и ссылка на вложение в ячейке D2.
и так далее.
Заранее спасибо!