Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Формирование и отправка писем из таблицы по фильтру.
 
Добрый день.

Помогите, пожалуйста, решить проблему.

Имеется таблица с именами и email адресами.
Задача; сформировать пакет писем только по видимым ячейкам таблицы (фильтр)

Заранее  спасибо !
 
МАССОВАЯ РАССЫЛКА ПИСЕМ ПО АДРЕСАМ
Согласие есть продукт при полном непротивлении сторон.
 
К сожалению там нет ответа.
Немного поясню.
Есть список допустим из 100 строк с адресами.

Выбираю фильтром допустим только 4 строки.
Необходимо, что бы сформировались письма не по всем 100 строкам, а только по видимому фильтру из 4 строк.

Спасибо !
 
Цитата
Daim написал:
К сожалению там нет ответа.
Есть там ответ. Сам проверял.
Если в мире всё бессмысленно, — сказала Алиса, — что мешает выдумать какой-нибудь смысл? ©Льюис Кэрролл
 
Код
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 = 1 To lLastR
        If Rows(lr).Hidden = False Then
        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
        End If
    Next lr
 
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub
Согласие есть продукт при полном непротивлении сторон.
 
Sanja - спасибо большое !!!!!!
То, что нужно.
Страницы: 1
Читают тему (гостей: 1)
Наверх