Страницы: 1
RSS
Массовая рассылка писем по адресам с завершением сообщением
 
Доброго дня всем! Нашел замечательный код для рассылки любого количества писем, что очень помогло сэкономить кучу времени. Вот он:
Код
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
 
    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 'текст сообщения
            .Attachments.Add Cells(lr, 4).Value
            .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
        End With
    Next lr
 
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub





Вопрос знатокам! Рассылать приходится около трехсот писем, и, естественно,это занимает время. Может кто поможет дописать код так,что бы по окончании рассылки выводилось сообщение о завершении операции, или еще лучше что то типа: "Операция успешно завершена. Отправлено столько то писем". Всем буду благодарен!
 
в фор вставить счетчик х=х+1
в конце процедуры
msgbox ""Операция успешно завершена. всего " & x &  "Писем"
у меня простая версия Экселя, в ней нет кнопки "Прочитать мысли и сгенерировать файл пример"
 
Цитата
Фродо написал: Делайте файл пример с чистого листа, ручками, и ваша лень заставит вас сделать простой и понятный файл пример
Понятно... Макросы на самом деле очень интересная тема! НО. Реально нет времени на изучение вопроса "в глубину"! Работа,ночь,работа..... Потому очень мало понимаю о чем Вы)))) Согласен,полный лузер!...
Цитата
Фродо написал: в фор вставить счетчик х=х+1...
Будьте добры, помогите,прям "для дураков".
 
evg_glaz, не напрягайтесь. Такой цикл ничего не даст кроме общего кол-ва писем. Крайне не хватает проверить - а действительно ли письмо было отправлено? А вот тут самое интересное: если просто неверный адрес(опечатка), то никаких ошибок или статусов не получим - письмо успешно уйдет на сервер и лишь потом сервер вернет ответ о неверном e-mail. Из VBA это не отследить.
В других случаях можно перед .Send очищать объект err, а после .Send проверять - если была ошибка, значит что-то не так и считаем письмо не отправленным. В любом случае 100% статистики не получите и смысла в ней особо нет.

В случае отправки через CDO чуть проще - там хоть ответ можно сразу получить...
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Код
[/CODE][CODE]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
  
    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 'текст сообщения
            .Attachments.Add Cells(lr, 4).Value
            .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
        End With
х=х+1
    Next lr
  msgbox "Операция успешно завершена. всего " & х & "Писем"
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub
Изменено: Фродо - 31.03.2016 18:05:52
у меня простая версия Экселя, в ней нет кнопки "Прочитать мысли и сгенерировать файл пример"
 
The_Prist,это понятно, оставляю так. Мне главное видеть, что действие завершено и можно работать дальше. спасибо!
 
Цитата
evg_glaz написал:
Мне главное видеть, что действие завершено и можно работать дальше
Для этого на моем же сайте есть это: Отобразить процесс выполнения кода
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Фродо, очень благодарен! Спасибо Вам за потраченное время!!!
 
The_Prist,спасибо, пытаюсь разобраться куда чего дописать...)))
 
А если такая ситуация:
Допустим разом мы отправляем 10 писем на один адрес [.to], но в копию 1 [.Cc] и копию 2 [.Cc] нужно чтобы улетело только первое письмо. Как быть в такой ситуации?
Спасибо за ответ.
Код
Private Sub Send()
    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
   
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear
    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
 
    lLastR = Cells(Rows.Count, 1).End(xlUp).Row
    
    For lr = 2 To lLastR
        Set objMail = objOutlookApp.CreateItem(0)
       
        With objMail
            .to = Cells(1, 8).Value
            .Cc = Cells(2, 8).Value
            .Cc = Cells(3, 8).Value
            .Subject = Cells(4, 8).Value
            .Body = Cells(5, 8).Value
            .Attachments.Add Cells(lr, 2).Value
            .Send
        End With
    Next lr
 
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
    
End Sub
 
Наверное, так:
Код
For lr = 2 To lLastR
        Set objMail = objOutlookApp.CreateItem(0)
        
        With objMail
            .to = Cells(1, 8).Value
            if lr = 2 then 'если первый раз идем по циклу, то отсылаем еще и копии
                .Cc = Cells(2, 8).Value
                .Cc = Cells(3, 8).Value 'правда, что-то подсказывает, что надо иначе ставить два адреса в копию....
            end if
            .Subject = Cells(4, 8).Value
            .Body = Cells(5, 8).Value
            .Attachments.Add Cells(lr, 2).Value
            .Send
        End With
    Next lr
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Спасибо. Получилось с первой копией. А со второй не вышло.
 
The_Prist, а не, все получилось. просто стоило подождать.
Большое спасибо за помощь.  
 
Код
.CC = Cells(2, 8).Value & "; " & Cells(3, 8).Value
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
The_Prist, спасибо, так стало еще лучше.
 
The_Prist, Добрый день!
А как быть если у меня есть шаблон письма в формате otf и мне надо указать адресат и файл прикрепить
Конструкция типа
Set objMail = objOutlookApp.CreateItemFromTemplate("C:......") вместо Set objMail = objOutlookApp.CreateItem(0)
не дает результата. Как это реализовать? Заранее благодарен.
 
Цитата
romma написал: в формате otf
oft имелось ввиду?
Вообще, конструкция вида:
Set objMail = objOutlookApp.CreateItemFromTemplate("C:\outltemplates\mailtempl.oft")
должна работать без проблем. Убедитесь, что шаблон действительно расположен по данному пути и правильно написан. И еще напишите, что значит "не дает результата". Ошибка появляется, не в том виде письмо или оно не отправляется, еще что-то...
Так же можно проверить корректность создания, используя метод .Display вместо .Send. Тогда созданное письмо будет отображено, но не отправлено.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
The_Prist,Это какая то магия.... от форума. Все повторил и получилось. БЛАГОДАРЮ!
 
Цитата
romma написал:
The_Prist ,Это какая то магия.... от форума. Все повторил и получилось. БЛАГОДАРЮ!
Спасибо, Вам за интересную тему!
Я дилетант в VBA поэтому разбирался долго, но в итоге все вышло)). В связи с чем и решил поделиться своим опытом с начинающими, может кому пригодиться.
Проблема была в том что при создании письма с использованием шаблона, Шаблон как мне казалось не подгружался (в теле письма было пустое сообщение).
Решил вопрос Установкой апострофа напротив заполнения текста сообщения. Получилось так:
Код
'.Body = Cells(lr, 3).Value 'текст сообщения
В противном случае, пустая ячейка текстового сообщения будет затирать текст шаблона.
Изменено: luft177 - 05.01.2017 22:22:38
 
Добрый день!
Подскажите, пожалуйста, как выбрать почтовый адрес, с которого будет уходить письмо, если их подключено несколько?
Через ".from = _____@___.ru" не получается.
 
Код
.SetOnBehalfOfName = "email"
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий, спасибо!
К сожалению, не срабатывает. Отправляет с основного email.
Прочитал на одном из форумов, что настроить отправку с другого подключённого ящика не получится. Будет всегда отправлять с основного ящика учётной записи.
 
Добрый день!
Если позволите хотелось бы тему продолжить.
Где и каким образом можно прописать такое свойство отправляемого письма, как важность.
Или например установить флаг "К исполнению"?
Спасибо.
 
Цитата
Алексей Демченко написал:
хотелось бы тему продолжить
тема так-то про завершающее сообщение, а не про все проблемы, связанные с отправкой писем :) Создайте новую тему согласно правил - а то здесь и так уже все в кучу свалили под девизом "ну про отправку же"...
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Страницы: 1
Наверх