Добрый день! Бывает необходимо раз в месяц отправлять письмо одному и тому же адресату с определенной целью - например запрос документов, отчетов и т. д. Данный макрос решает данную задачу. Необходимо поместить код в ThisOutlookSession и каждый раз в определенную дату при запуске Outlook адресату будет отправляться "нужное" письмо.
Private Sub Application_Startup() Dim n As Long Dim dt As Date, d As Integer d = Day(Now) n = GetSetting(APP_ID, SECT_ID, KEY, 0)
If n = 0 And d = 2 Then Dim objOL As Outlook.Application Dim objMail As MailItem Set objOL = Outlook.Application Set objMail = objOL.CreateItem(olMailItem) With objMail .SendUsingAccount = .Session.Accounts.Item(2) 'указывается порядковый номер аккаунта для выбора адреса отправки .To = "" 'указывается адрес получателя .CC = "" .Body = "Добрый день! Пришлите пожалуйста подписанный акт сверки за предыдущий месяц" 'указывается текст письма .Subject = "Запрос акта сверки" 'указывается тема письма .Send End With Set objMail = Nothing Set objOL = Nothing n = 1 SaveSetting APP_ID, SECT_ID, KEY, n End If
If d <> 2 Then n = 0 SaveSetting APP_ID, SECT_ID, KEY, n End If End Sub
[/vba]
Добрый день! Бывает необходимо раз в месяц отправлять письмо одному и тому же адресату с определенной целью - например запрос документов, отчетов и т. д. Данный макрос решает данную задачу. Необходимо поместить код в ThisOutlookSession и каждый раз в определенную дату при запуске Outlook адресату будет отправляться "нужное" письмо.
Private Sub Application_Startup() Dim n As Long Dim dt As Date, d As Integer d = Day(Now) n = GetSetting(APP_ID, SECT_ID, KEY, 0)
If n = 0 And d = 2 Then Dim objOL As Outlook.Application Dim objMail As MailItem Set objOL = Outlook.Application Set objMail = objOL.CreateItem(olMailItem) With objMail .SendUsingAccount = .Session.Accounts.Item(2) 'указывается порядковый номер аккаунта для выбора адреса отправки .To = "" 'указывается адрес получателя .CC = "" .Body = "Добрый день! Пришлите пожалуйста подписанный акт сверки за предыдущий месяц" 'указывается текст письма .Subject = "Запрос акта сверки" 'указывается тема письма .Send End With Set objMail = Nothing Set objOL = Nothing n = 1 SaveSetting APP_ID, SECT_ID, KEY, n End If
If d <> 2 Then n = 0 SaveSetting APP_ID, SECT_ID, KEY, n End If End Sub