Автоматическая отправка e-mail через outlook по дате.

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

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

Neznaika0457

Дата: Пятница, 02.12.2022, 15:20 | Сообщение № 1

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

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

Сообщений: 3

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

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

Добрый день!
Вводные: есть таблица Excel с данными Компаний, которые проходили обучение (каждый год имеет отдельный Лист в таблице) и получили сертификат сроком на 2 года. Соответственно, по окончании действия сертификата (за один месяц) необходимо напомнить Компании, что срок действия сертификата истекает. В Excel таблице записаны следующие данные, даты прохождения обучения, название компаний, контактная информация (тел. , e-mail), ФИО. Данные в таблицу заносятся в ручную, после каждого обучения. В среднем в месяц 5...10 контактов *12 месяцев. Ведётся с 2018 года.

Задача: необходима автоматическая рассылка писем через Оutlook (тема, тело письма, подпись +файл с вложением). Рассылка должна производиться на основании данных (даты) из таблицы Excel, за один месяц до окончания даты срока действия сертификата.

Что есть: взял готовый макрос из интернета и допилил его - есть тема, само письмо, есть подпись и файл с вложением. НО нет автоматической рассылки, только в ручную, командой run.

Сильно не пинайте, это первый опыт в макросах

.

[vba]

Код

Sub send_email()
Dim olApp As Object

Dim olMailItm As Object
Dim iCounter As Integer
Dim Dest As Variant
Dim SDest As String
' e-mail subject
strSubj = "Окончание срока сертификата (название компании)"
On Error GoTo dbg
' creating odject for Outlook
Set olApp = CreateObject("Outlook.Application")
For iCounter = 1 To WorksheetFunction.CountA(Columns(1))
' creating new element (email message) in Outlook
Set olMailItm = olApp.CreateItem(0)
strBody = ""
useremail = Cells(iCounter, 1).Value
FullUsername = Cells(iCounter, 2).Value
Status = Cells(iCounter, 4).Value
pwdchange = Cells(iCounter, 3).Value
' body of the email
strBody = "Вас приветствует команда (название компании)!" & vbCrLf
strBody = strBody & "   " & vbCrLf
strBody = strBody & "Приглашаем на сервисное обучение (тело письма) " & vbCrLf
strBody = strBody & " Дата окончания действия сертификата " & pwdchange & vbCrLf
strBody = strBody & " Надеемся на дальнейшее сотрудничество! " & vbCrLf
strBody = strBody & "   " & vbCrLf
strBody = strBody & "---" & vbCrLf
strBody = strBody & ""
strBody = strBody & "Best regards," & vbCrLf
strBody = strBody & ""
strBody = strBody & " " & vbCrLf
strBody = strBody & ""
strBody = strBody & "Andrew " & vbCrLf
strBody = strBody & ""
strBody = strBody & "Tel.: +7" & vbCrLf
strBody = strBody & ""
strBody = strBody & "Tel: +7  (Moscow)" & vbCrLf
olMailItm.To = useremail
olMailItm.Subject = strSubj
olMailItm.BodyFormat = 1
' 1 - text format of letter, 2 - HTML format
olMailItm.Body = strBody
olMailItm.Attachments.Add "C:\Users\Desktop\УНО\Cервисное обучение на I-квартал 2023 год.pdf"
olMailItm.Save
olMailItm.Send
' etu strochku mojno ispolzovat dlia otkladki pisma
'MsgBox strBody
Set olMailItm = Nothing
Next iCounter
Set olApp = Nothing
dbg:
'errors,if yes
If Err.Description <> "" Then MsgBox Err.Description
End Sub

[/vba]

.

[vba]

Код

[/vba]Neznaika0457

Сообщение отредактировал Neznaika0457 - Пятница, 02.12.2022, 15:46

Ответить

СообщениеДобрый день!
Вводные: есть таблица Excel с данными Компаний, которые проходили обучение (каждый год имеет отдельный Лист в таблице) и получили сертификат сроком на 2 года. Соответственно, по окончании действия сертификата (за один месяц) необходимо напомнить Компании, что срок действия сертификата истекает. В Excel таблице записаны следующие данные, даты прохождения обучения, название компаний, контактная информация (тел. , e-mail), ФИО. Данные в таблицу заносятся в ручную, после каждого обучения. В среднем в месяц 5...10 контактов *12 месяцев. Ведётся с 2018 года.

Задача: необходима автоматическая рассылка писем через Оutlook (тема, тело письма, подпись +файл с вложением). Рассылка должна производиться на основании данных (даты) из таблицы Excel, за один месяц до окончания даты срока действия сертификата.

Что есть: взял готовый макрос из интернета и допилил его - есть тема, само письмо, есть подпись и файл с вложением. НО нет автоматической рассылки, только в ручную, командой run.

Сильно не пинайте, это первый опыт в макросах

.

[vba]

Код

[/vba]

Автор - Neznaika0457
Дата добавления - 02.12.2022 в 15:20

_Boroda_

Дата: Пятница, 02.12.2022, 15:44 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 16719

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

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Повесьте запуск этого макроса на событие открытия книги. Чтобы несколько раз не отправлял, сделайте проверку даты последней отправки
[vba]

Код

Private Sub Workbook_Open()
    With Me.Worksheets(1)
        If Cells(1) <> Date Then
            send_email
            Cells(1) = Date
        End If
    End With
End Sub

[/vba]

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995