Создать пачку писем и задержку отправки

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Создать пачку писем и задержку отправки (Макросы/Sub)

akme24

Дата: Среда, 17.07.2024, 18:03 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 1

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Доброго времени суток всем.
Есть рассылка писем из Excel файла в виде макроса, но у mail.ru есть ограничения на количество отправляемых писем в минуту.
Нужна помощь в реализации алгоритма в формировании пачки писем 40 штук и последующей задержки отправки писем на 60 секунд и так до конца списка.
Я реализовал рассылку следующим образом

[vba]

Код

Sub Group_Mail_Sending()
    If MsgBox("Вы уверены, что хотите начать процесс рассылки писем?" & vbCr & "Если процесс рассылки запустить, его нельзя будет прервать!", vbYesNo, "Рассылка писем") = vbNo Then Exit Sub

    Const strConstPartOfSchema = "http://schemas.microsoft.com/cdo/configuration/"
    Dim xlRows As Long, xlLastRows As Long
    xlLastRows = Cells(Rows.Count, 1).End(xlUp).Row 'Вычисляем последнюю заполненную ячейку в столбце А

    Const lMaxQuad As Long = 20 'Сколько квадратов выводить

    For xlRows = 2 To xlLastRows 'Цикл от второй строки(начало списка с e-mail адресами) до последней вычисленной ячейки таблицы
        'Создаем новое сообщение
        With CreateObject("CDO.Message")    'Создаем объект CDO
            .From = "username@domain.com"            'От кого отправляем (Display Name <email_address>)
            .To = Cells(xlRows, 1).Value        'Кому отправляем (Display Name <email_address>) / Столбец E-mail получптеля
            .Subject = Cells(xlRows, 2).Value   'Тема письма / Столбец Тема письма
            .TextBody = Cells(xlRows, 3).Value  'Текс cообщения / Столбец Текст письма
'            .TextBody = "Тестовая рассылка!" + + "\r\n" + "Тестовая рассылка!" 'Текс cообщения
'            .HTMLBody = "<html><body><h3>Тестовая рассылка!</h3></body></html>" 'Текс cообщения
'            .Attachments.Add Cells(xlRows, 4).Value 'Путь и имя файла, которое нужно прикрепить к письму
            .TextBodyPart.Charset = "koi8-r"    'Кодировка текста письма (koi8-r, utf-8, windows-1251)
            With .Configuration.Fields
                .Item(strConstPartOfSchema & "smtpserver") = "smtp.mail.ru"           'Адрес SMTP-сервера
                .Item(strConstPartOfSchema & "sendusing") = 2                         'Без использования каталога Exchange Server
                .Item(strConstPartOfSchema & "smtpserverport") = 25                   'Порт (альтернативный - 465)
                .Item(strConstPartOfSchema & "smtpauthenticate") = 1                  'Тип авторизации (0 = None, 1 = Basic, 2 = NTLM)
                .Item(strConstPartOfSchema & "sendusername") = "username@domain.com"       'Имя пользователя (вид username@domain.com)
                .Item(strConstPartOfSchema & "sendpassword") = "************" 'Пароль пользователя, специально созданный для приложения на mail.ru
                .Item(strConstPartOfSchema & "smtpusessl") = True                     'Использовать SSL шифрование (True - Да, False - Нет)
                .Item(strConstPartOfSchema & "smtpconnectiontimeout") = 60            'Время до завершения повторных попыток подключения
                .Update
            End With
            .Send 'Отсылаем сообщение
            Application.StatusBar = "Выполнено: " & Int(100 * xlRows / xlLastRows) & "%" & String(CLng(lMaxQuad * xlRows / xlLastRows), ChrW(9632)) & String(lMaxQuad - CLng(lMaxQuad * xlRows / xlLastRows), ChrW(9633))
            DoEvents
        End With
    Next xlRows
    MsgBox ("Рассылка писем завершена!")
    Application.StatusBar = False 'Очищаем статус-бар от значений после выполнения (рассылки)
End Sub

[/vba]
Возможно еще будут у кого то замечания и предложения по коду, к примеру нужно ли как то отлавливать ошибки при отправке писем и как это можно сделать.
То тоже напишите пожалуйста. (с) Я не волшебник я только учусь.

[vba]

Код

К сообщению приложен файл: 6637905.png (94.4 Kb)

Сообщение отредактировал akme24 - Среда, 17.07.2024, 18:18

Ответить

СообщениеДоброго времени суток всем.
Есть рассылка писем из Excel файла в виде макроса, но у mail.ru есть ограничения на количество отправляемых писем в минуту.
Нужна помощь в реализации алгоритма в формировании пачки писем 40 штук и последующей задержки отправки писем на 60 секунд и так до конца списка.
Я реализовал рассылку следующим образом

[vba]

Код

Автор - akme24
Дата добавления - 17.07.2024 в 18:03

Создать пачку писем и задержку отправки (Макросы/Sub)

Страница 1 из 1
1