mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

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

Пример макроса, отправляющего письма со вложениями из Excel через почтовый клиент Outlook:

Sub Отправить_Письмо_из_Outlook()
 
    'отправляем письмо без вложений
    res = SendEmailUsingOutlook("name@domain.ru", "Текст письма 1", "Тема письма 1")
    If res Then Debug.Print "Письмо 1 отправлено успешно" Else Debug.Print "Ошибка отправки"
 
 
    'отправляем письмо с 1 вложением
    attach$ = ThisWorkbook.FullName    ' прикрепляем текущий файл Excel
    res = SendEmailUsingOutlook("name@domain.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("name@domain.ru", "Текст письма 3", "Тема письма 3", coll)
    If res Then Debug.Print "Письмо 3 отправлено успешно" Else Debug.Print "Ошибка отправки"
End Sub

Макрос использует функцию SendEmailUsingOutlook, которая:

  • принимает в качестве параметров адрес получателя письма, тему и текст письма, список вложений
  • запускает Outlook, формирует письмо, и отправляет его
  • возвращает TRUE, если отправка прошла успешно, или FALSE, если с отправкой почты вызникли проблемы

 

Код функции SendEmailUsingOutlook:

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 100000: DoEvents: Next    ' без паузы не отправляются письма без вложений
        Err.Clear: .Send
        SendEmailUsingOutlook = Err = 0
    End With
    Set OutApp = Nothing
End Function

 

Пример макроса, с получением параметров письма из ячеек листа Excel: 

Sub Отправить_Письмо_из_Outlook()
    ' адрес получателя - в ячейке A1, текст письма - в ячейке A2
    res = SendEmailUsingOutlook(Cells(1, 1), Range("a2"), "Тема письма 1")
    If res Then Debug.Print "Письмо 1 отправлено успешно" Else Debug.Print "Ошибка отправки"
End Sub

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

СПАСИБО!!!

Можем сделать под заказ.

Добрый день.
Отправка писем данным макросом работает прекрасно, но можно добавить параметр который отвечает за отправку письма не сразу, а в назначенную дату и время ?
Необходима рассылка уведомлений за 10 дней до контрольной даты.
Заранее спасибо за ответ.

Александр, я не консультирую по бесплатным макросам, тем более, если они написаны не мной.
Обратитесь на форумы по Excel, там помогут.

Здравствуйте,снова :)
Пошел по Вашему совету =>
1. сначала файл сохраняю в формате .pdf в определенной папке
2. Отправляю файл с прикреплением этого файла из определенной папки
Вот только проблемка, он файл сохраняет, но ничего не отправляется...

Макрос ниже:

Sub save_in_pdf_and_send_email()
Dim s$
s = "C:\Users\alexander.leontyev\Desktop\60_SQA\10. Supplier perfomance\SP"
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:\Users\alexander.leontyev\Desktop\60_SQA\10. Supplier perfomance\SP" & "\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

End Sub

Спасибо большое, сейчас попробую :)

1. листа в формате PDF не существует.
если хотите его прикрепить, - сначала надо сохранить этот лист в формате PDF в файл
иначе - никак. впрочем, это происходит моментально и незаметно для пользователя, если макрос правильно написан
ваш код тут не подойдет, - он подходит только для отправки книги в обычном формате (Excel)
для PDF нужен совсем другой код (с использованием CDO или почтовой программы типа Outlook)

2. в четвёртой строке, в коде ошибка: .CC = Range("h25") & Range("h26") тут не в тему
метод SendMail объекта Workbook не поддерживает указание получателей копии в таком виде (надо указывать массив текстовых значений)
попробуйте заменить четвертую строку следующим:

.SendMail Recipients:=array(Range("h21") & Range("h22"), Range("h25") & Range("h26")), Subject:="SP"

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 из статьи по ссылке)

'отправляем письмо с несколькими вложениями
    FolderPath = "c:\MyFolder\"
    Dim coll As NEW Collection    ' заносим в коллекцию список прикрепляемых файлов
    Set FSO = CreateObject("Scripting.FileSystemObject")    ' создаём экземпляр FileSystemObject

    GetAllFileNamesUsingFSO FolderPath, "*.pdf", FSO, coll, 1 ' поиск файлов ПДФ с добавлением найденный в коллекцию coll
    GetAllFileNamesUsingFSO FolderPath, "*.htm", FSO, coll, 1 ' поиск файлов HTM с добавлением найденный в коллекцию coll
    ' а чтобы без расширения файлы прикрепить - немного код надо будет доработать

    res = SendEmailUsingOutlook("name@domain.ru", "Текст письма", "Тема письма", coll)

Подскажите пожалуйста а как сделать что бы В письмо будет вкладываться все файлы с расширениями .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

Добрый день. Подскажите как в тело письма вносить диаграммы и текст с листа excel?

Да, это можно реализовать.
Оформляйте заказ на сайте, прикрепляйте примеры файлов, — сделаем.

Добрый день!
Помогите пожалуйста составить макрос или через УФ. Суть такова:
Есть к примеру в ячейке "В2" Город получатель(города разные)...необходимо что бы при активации(как при гиперссылке) данного города отправлялось письмо с номером индекса, который находится в ячейке "А1", либо при вводе текста в ячейке "С1".."Запрос"...автоматически уходило письмо в город получатель("B2") с номером индекса("A1").
Это можно как-то реализовать?
Заранее спасибо!

Добрый день. Задача такая: есть файл на общем ресурсе, в который периодически вносятся изменения (график работы), нужно чтобы после внесения изменений в файл все сотрудники получали уведомление об изменениях (без вложений, с текстом изменения в теле письма, например "ячейка А1 изменена с 1 на 3"). При этом нужно чтобы письмо формировалось и уходило автоматом. Благодарю вас за вашу работу и за ваш сайт.

Большое спасибо за помощь!
В результате у меня получился макрос гораздо сложнее. С помощью рекордера я записал программу, чтобы макрос брал из исходной книги часть ячеек, копировал их в новую книгу и форматировал должным образом. А дальше я руками дописал код, чтобы файл сохранялся в нужную мне папку (если её нет - чтобы она создавалась) под нужным мне именем, а не как Book 2. А в письмо подставляется нужный адресат, нужный заголовок и подцепляется только что созданный файл.

Большую часть всего этого я сделал благодаря материалам, опубликованным на вашем сайте.
Поэтому ещё раз спасибо!

1) берете макрос, который формирует письмо по ячейкам
2) ищете в инете макрос. которых сохраняет диапазон ячеек в файл
3) вставляете второй макрос в середину первого

макрос сохранения диапазона ячеек в файл можете записать сами, макрорекордером.
всего-то 5 строк:

worksheets(2).range("a2:d10").copy  ' копируем ячейки со второго листа
with workbooks.add
  .worksheets(1).cells(1).pastespecial ' вставляем в новую книгу скопированные ячейки
  .saveas "c:\attach.xls" ' сохраняем
  .close false ' закрываем файл
end with

потом только в ваш макрос (первый) надо добавить с код формирования письма одну строку типа

.attachments.add "c:\attach.xls"

Уважаемый администратор сайта, спасибо за ответ.
Как мне кажется, мой вопрос проще и требует не надстройки, а макроса.

У меня есть экселевский файл, в котором на листе 1 в одной ячейке указан e-mail, а у другой - заголовок.
Дальше у меня есть лист 2 с какой-то информацией. И требуется нажатием одной кнопки формировать письмо, которое будет копировать часть ячеек с листа 2 в новую книгу, создавать e-mail, подставляя туда адрес и заголовок с листа 1, и в качестве вложения прикреплять новую книгу. Человеку нужно будет только дописать в письме необходимый сопроводительный текст (он каждый раз разный) и нажать кнопку "Отправить".

По поводу того, чтобы вручную сохранить диапазон и прикреплять его, - это нежелательный вариант. Заказчик хотел бы всё делать одной кнопкой.

Я нашёл макрос, который подставляет необходимые параметры письма из ячеек книги. И нашёл макрос, который копирует лист и отправляет его по заранее заданному адресу. Но проблема в том, что я не знаю, как их объединить. Я в экселе копаюсь давно и довольно глубоко, но моя область - формулы, а макросы мне практически никогда не требовались.

Здравствуйте, Леонид.
Чтобы формировать письмо по шаблону, подставляя в адресата, текст и тему содержимое ячеек, - воспользуйтесь готовым решением:
http://excelvba.ru/programmes/FillDocuments
Там много возможностей в плане рассылки

Насчет прикрепления диапазона ячеек, - так вы сохраните этот диапазон в файл (книга Excel, или в формате картинки)
И потом прикрепляйте этот файл к письмам.

Здравствуйте,
Можно ли дописать макрос так, чтобы параметры письма (адресат, тема) подставлялись из ячеек листа 1, но при этом к письму прикреплялся лист 2?
А в идеале, чтобы прикреплялся не целиком лист 2, а определенный диапазон. Допустим, A1:D10.

ОГРОМНОЕ спасибо!!! Встроил функцию в Бланк-заказ компании. Прямо чувствую себя программистом ))

Что удобнее, - вопрос точно не ко мне. Реализовать можно любой вариант.
Копироваться, — конечно автоматически (иначе зачем макрос писать...)
Если нужно готовое решение, - оформляйте заказ на сайте, сделаем.

А копироваться строка в файл будет автоматически?

Насколько это удобно? Или легче скопировать строку и выслать по мэил?

Да всё можно, - только макрос надо серьёзно переделывать
(если вместо прикрепления файла, надо в тело письма вставлять строку с данными)

Если же надо прикрепить к письму ФАЙЛ с одной строкой - то проще

Добрый день!
А можно отправлять только новую строку с листа?

Отписка делается средствами сайта
В письме, отписка, - это обычная гиперссылка вида site.ru/unsubscribe.php?code=XXXXXXXXXXXXXX
при переходе по которой скрипт unsubscribe.php на сайте site.ru добавляет в базу данных отметку, что больше не надо слать письма на этот email

В вашем же случае, при рассылке через аутлук, что бы там в письме пользователь не щелкнул, - на вашем компе в вашем файле Excel никакой отметки не появится
(не, конечно, всё можно сделать, если есть свой сайт, - но это сложно)

Насчет узнать, доставлено письмо, прочитано или нет, отмечено ли как спам, - нереально.
(сами подумайте, откуда эти данные у вас могут появиться... если все происходит на компе получателя письма, и обратной связи никакой нет, кроме как если пользователь вам напишет ответное письмо)

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

В моем понимание, что такое отписка.
В конце письма, есть кнопочка ОТПИСКА
человек нажимает на нее, и я получаю его email. И больше ему не напишу (альтернатива когда человек выбирает СПАМ).
На многие emai сервисах, это есть автоматически.

И еще вопрос есть ли реализации, в получении следующих данных (емейлов) о рассылке через макрос, который использует outlook: 1) Доставлено 2) Прочитано 3) Помечено как спам 4) Отписалось

Здравствуйте, Максим.
Чтобы письмо формировалось в формате HTML, надо вместо

.Body = MailText$

написать
.HTMLBody = MailText$: .BodyFormat = 2        ' olFormatHTML = 2

по второму вопросу, - я не знаю, что такое «отписка» в вашем понимании

Добрый день, понравилась реализация через Outlook
сделал три колонки email, Текст письма, Тема письма.
Первый вопрос: шаблон письма в HTML, и получаю по почте текст письма в таком же HTML, как сделать, чтобы текст письма, преобразовался.
И второй вопрос, как сделать отписку!

Спасибо. Буду искать.

Здравствуйте
К сожалению, в вопросе цифровой подписи ничем помочь не смогу, - ни разу не сталкивался с таким.
Обратитесь на форумы по 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 стоит галочка не предупреждать. программа

Вот вы находите изначально рабочий макрос, что-то в нём меняете, — а потом меня спрашиваете, что не работает, не показывая код со своими правками...

Я указываю там тот путь, по которому расположен мой файл на компьютере.
Например «C:\Users\Алексей\Desktop\Excel таблицы для тренировки\города филиалов».

это разве путь к файлу Excel?
Где расширение файла? Возможно, из-за этого файл не видит (т.к. имя файла неверно указано)

Добрый день!
Есть следующий вопрос (см.ниже, взят из интернета):
Нужно из 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

Здравствуйте, Дмитрий

Насчет подписи, - самый простой способ добавить её снизу в текст письма.
Если ещё в HTML сделать, - даже красиво получится

По второму вопросу - достаточно одного макроса
Всем кнопкам назначьте один и тот же макрос: (предварительно выделив все кнопки)

Sub MacroForButton()
    On Error Resume Next
    ' определяем строку, в которой расположена нажатая кнопка
    Dim ro As Range: Set ro = ActiveSheet.Shapes(Application.Caller).TopLeftCell.EntireRow
    MsgBox "Нажата кнопка в строке " & ro.Row & ", где во втором столбце значение «" & ro.Cells(2).Value & "»"
End Sub

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

Здравствуйте, Антон.
Используйте для рассылки готовую надстройку: http://excelvba.ru/programmes/FillDocuments
В последней версии, там появилась возможность задать интервал (в секундах, от и до) между отправляемыми письмами
(при рассылке через Outlook)

Здравствуйте, я пользуюсь макросом для отправки писем. как его доделать, чтобы можно было отсылать по расписанию. 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

Здравствуйте, Илья.
Всё можно дописать.
Оформляйте заказ, - сделаю.

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  _  _     _       _                        _     
| || | | | | | __ ___ __ __ | |
| || |_ | | | |/ / / __| \ \ /\ / / | |
|__ _| | |___ | < | (__ \ V V / | |___
|_| |_____| |_|\_\ \___| \_/\_/ |_____|
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

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