Отправка писем из Outlook по расписанию
Краткое описание
Макрос в заданный интервал времени (раз в сутки, в среду вечером, раз в неделю или в иное указанное вами время) отправляет письма из указанной папки Outlook. При этом данные письма не удаляются, а служат своего рода шаблоном. То есть один раз создали письмо-шаблон и в заданное время без вашего участия будет происходить его отправка.
Подробное описание
Представьте ситуацию. Например, вам нужно каждый вторник отправлять однотипные письма-напоминая вашим партнерам или коллегам по работе. Что-то вроде: "Уважаемые коллеги, напоминаем, срок сдачи договоров - пятница. Будьте пунктуальны, от этого зависит ваше вознаграждение". К сожалению, в стандартном функционале Outlook данной возможности не предусмотрено. Максимум - отложенная отправка, но это совсем другое. С помощью указанного нами способа теперь это возможно. Всё, что необходимо: один раз создать шаблон, один раз настроить задачу в Outlook и теперь каждый вторник в заданное вами время будет происходить отправка нужного вам письма. Установка макроса довольно-таки проста: Также обратите внимание: - При необходимости в настройках скрипта можно задать фильтр по теме письма. Outlook вообще очень гибок в плане автоматизации в среде MS Office. Можно делать много интересных вещей. Была бы необходимость. Поэтому, не стесняйтесь, пишите, спрашивайте.
- Если на момент отправки письма Outlook выключен, отправка будет возобновлена после включения программы.
Set OutFolder = GetNamespace(«MAPI»).Folders(CStr(Session.CurrentUser)).Folders(«Расписание»)
А папка «Расписание» у вас создана?
В макросе есть строка Set NewItem = OutFolder.Items(i).Copy 'создаем копию письма
Если её удалить, то при отправке из папки удаляется и оригинал письма, а если оставить эту строку, то появляется дубль письма.
Как найти среднее решение, чтобы только 1 письмо находилось в папке?
Спасибо.
И это успешно работало в Outlook 2007 (32 бит), ОС Windows 7 (32 бит).
Возможно, у вас в Outlook настроено, не перемещать папку в Отправленные после отправления.
Если нет, сообщите версию вашего офиса и ОС, проверю у себя на вашей конфигурации.
Если даже поставить галочку напротив «перемещать письма в папку отправленные», то всё равно происходит то же самое. Остаётся дополнительная копия письма.
Windows XP, Outlook 2010.
Если есть может дополнительная надстройка или задача, чтобы удалять лишние копии и чтобы в папке было только одно письмо.
Спасибо.
Создайте в Outlook пустой модуль и поместите туда нижеуказанный код.
Далее запустите процедуру «SelectFolder».
После исполнения кода на рабочем столе появится файл «outlook_folder.txt», который будет содержать список папок в вашем Outlook.
Убедитесь:
1) что в указанном списке папок есть папка Расписание
2) папка Расписание находится в блоке вашей дефолтной учетной записи
Также обратите внимание, что папку Расписание лучше размещать в корне вашего почтового ящика (без дополнительных вложенностей в другие папки).
Sub SelectFolder() Dim oOutlook As New Application, oNamespace As NameSpace, oChildFolder As MAPIFolder Set oNamespace = oOutlook.GetNamespace("MAPI") 'перебираем каждую папку верхнего уровня и получаем список ее подпапок через процедуру DoFolder' For Each oChildFolder In oNamespace.Folders InsertTXT vbCrLf & "-> " & oChildFolder.Name DoFolder oChildFolder Next End Sub Sub DoFolder(ByVal oFolder As MAPIFolder) Dim oChildFolder As Outlook.MAPIFolder For Each oChildFolder In oFolder.Folders InsertTXT oChildFolder.Name DoFolder oChildFolder 'каждую дочернюю папку опять пропускаем через процедуру DoFolder' Next End Sub Function InsertTXT(ByVal txt As String) As Boolean Dim FSO, TS, fName As String fName = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\outlook_folder.txt" On Error Resume Next: Err.Clear Set FSO = CreateObject("scripting.filesystemobject") Set TS = FSO.OpenTextFile(fName, 8, True): TS.Write txt & vbCrLf: TS.Close Set TS = Nothing: Set FSO = Nothing InsertTXT = Err = 0 End FunctionSet OutFolder = GetNamespace("MAPI").Folders(CStr(Session.CurrentUser)).Folders("Расписание")В частности, из-за Session.CurrentUser, который отображает ФИО пользователя.Если же у вас ящик именуется не в формате ФИО, а как есть (вроде login@domen.ru), то вышеуказанную строку надо заменить на:
Set OutFolder = GetNamespace("MAPI").Folders(CStr(Session.Accounts.Item(1))).Folders("Расписание")Цифра 1 в данном случае — это порядковый номер вашего ящика. Если у вас их несколько, то цифра может быть другой.Пишет: Sub or Function not defined
Set NewItem = OutFolder.Items(i).Copy 'создаем копию письма NewItem.Attachments.Add ("C:\Users\Admin\Desktop\test.txt") 'новая строка: добавить вложение Call NewItem.Send 'отправляем письмоНо это в самом простом виде, когда файл вложения у вас статичен и нет привязки к конкретному письму-шаблону.Прочие условия несложно доработать. Например, вкладывать файл, ориентируясь по его дате создания или наименованию. Или делать вложение, исходя из названия письма или получателя. В общем, здесь уже исходя из задачи.
возвращаясь к сообщению excelstore.pro/examples-of-work/internet/sending-emails-from-outlook-on-a-schedule.html#comment-122
Может быть есть макрос для очистки папки от дублирующих писем?
Или надстройка какая-нибудь? Пока всё, что я находил, платное.
А вообще, странно что текущая версия макроса так работает на вашей конфигурации. Я пока еще не проверял, но на этой неделе обязательно проверю.
Можно даже просто по количеству: если в папке более 1 письма, то лишние удалить.
Буду очень признателен за помощь!
Перебор писем осуществляется в папке «Расписание», которая должна располагаться в корне вашего ящика (не быть вложенной в другие папки).
Удаление сделал по количеству (удаляются все письма, кроме одного).
Sub DeleteMail() Dim OutFolder As Folder, i As Integer, k As Integer 'Set OutFolder = GetNamespace("MAPI").Folders(CStr(Session.Accounts.Item(1))).Folders("Расписание") Set OutFolder = GetNamespace("MAPI").Folders(CStr(Session.CurrentUser)).Folders("Расписание") k = OutFolder.Items.Count For i = k To 2 Step -1 OutFolder.Items(i).Delete Next i End SubКод проверял на Windows 7 (64 bit), Office 2013 (64 bit). На прочих версиях не тестировал.Если заругается на строку:
Set OutFolder = GetNamespace("MAPI").Folders(CStr(Session.CurrentUser)).Folders("Расписание")то закоментируйте её и раскоментируйте вышестоящую:Set OutFolder = GetNamespace("MAPI").Folders(CStr(Session.Accounts.Item(1))).Folders("Расписание")Макрос работает, спасибо большое!
А скажите, пожалуйста, как сделать так, чтобы он запускался раз в сутки?
Outlook открыт на рабочей станции 24 часа в сутки.
Письмо отправляется с утра и надо, чтобы потом в течение дня макрос удалял лишнюю копию. Можно это реализовать?
Поставьте макрос на расписание. Например, так: excelstore.pro/examples-of-work/other/run-jobs-on-a-schedule-in-windows.html
А вообще, как я писал выше, надо редактировать исходный макрос, чтобы он удалял копию сразу после отправки письма. Поэтому раз у вас работает процедура DeleteMail, то попробуйте включить ее в основную процедуру — Application_Reminder. Это проще и правильнее.
Потестировал скрипт для ежедневной рассылки писем в течение двух недель. Обнаружил проблему «выходного дня». Т.е. после выходных при включении почты (в понедельник) выполняется отправка письма по просроченному напоминанию от выходных (на выходных ПК выключен). Со вторника уже письма не отправляются. Подскажите, пж-та, как пофиксить данную проблему?
Проверьте настройки вашей задачи в outlook. Возможно, именно в них кроется причина.
Если Outlook ведет себя не так как ожидается, то возможно стоить использовать другой подход. Например:
1. не закрывать Outlook, чтобы напоминания не проскакивали;
2. доработать макрос, чтобы кроме отправки письма он также корректно смещал бы и дату напоминания;
3. использовать планировщик в Windows, который запустит выполнение нужного скрипта независимо от того, открыт Outlook или нет;
4. использовать веб-сервис, который по крону будет делать нужную рассылку без привязки к Outlook и Windows.
Продолжая тему excelstore.pro/examples-of-work/internet/sending-emails-from-outlook-on-a-schedule.html#comment-141
Помогите, пожалуйста, встроить код по удалению копии письма в основной код.
Пробовал много вариаций. Или вообще не работает или появляется s019.radikal.ru/i621/1704/7b/87a211797dec.png
Но ведь отдельно он работал, просто я где-то недопонимаю.
Спасибо!
Макрос не влияет на работу расписания. Логика работы расписания исключительно на стороне Outlook. Макрос только отлавливает нужные события и по ним уже выполняет какие-то действия. Но инициирует данные события именно Outlook.
Есть у кого макрос на отправку писем за исключением выходных?
С указанием времени, мне нужно в рабочие дни отправить утром одно письмо и вечером одно и тоже.
Заранее спасибо.
В виду проблем с выходными днями, описанных выше, альтернативным решением может быть:
1. Использовать планировщик windows, который в нужный интервал времени будет вызывать соответствующий макрос и производить отправку писем.
2. Использовать сторонние сервисы по отправке емаил. Т.е. на стороннем сервисе настраиваете отправку письма на ваш ящик в нужный интервал времени. Соответственно, когда данное письмо поступит в ваш outlook, сработает макрос, который в свою очередь запустит нужную вам рассылку.
Готового решения нет. Если вопрос актуален, могу написать за соответствующую плату. По вопросам заказа такого решения пишите на почту info@excelstore.pro
Работаю над подобной задачей, но не силен в VBA, да и времени разбираться нет. Если Вам не трудно, подскажите решение.
Из сторонней программы (1С), создается задача (напоминание) в Outlook. Как сделать так, что бы по времени этой задачи создавалось и отправлялось письмо.
Спасибо.
В макросе из данной статьи именно это и происходит: срабатывает напоминание, макрос его перехватывает и создает/отправляет письмо.
Что именно вызывает затруднение в текущем коде макроса?
трудность в том, что задача создается программно, и каждый раз новая. соответственно, как я понимаю, и макрос должен каждый раз в нее вписываться заново. Письмо, которое нужно отправить, находиться в виде вложения, в этой задаче.
А как создать задачу с записанным в нее макросом я не понимаю. :))
Спасибо.
Понятно. Тогда макрос из данной темы, конечно, не подойдет.
Но в вашем случае никакой макрос ни в какую задачу записывать не надо. Макрос будет находиться в Outlook-e и он всегда один и неизменен. Иными словами, нужен другой макрос или, как вариант, внешний скрипт, который будет проверять задачи и по нужному времени выдергивать из них вложение (письмо) и отправлять его.
Могу реализовать вам нужный макрос на платной основе. Детали и стоимость разработки можем обсудить в личной переписке. Если актуально, напишите мне на info@excelstore.pro
Изначально у меня ругался на с ФИО. Я заменил эту:
Set OutFolder = GetNamespace(«MAPI»).Folders(CStr(Session.Accounts.Item(1))).Folders(«Расписание»)
Но всё равно он ругается на эту же строку. Пишет следующее:
Run-time error '-2147221233 (8004010f)':
Сбой операции. Объект не найден.
Прочитал весь этот форум и не нашёл нужного решения.
Папка была создана в ветке «Файлы данных „Outlook“.
Я перенёс её в ветку под свою почту и всё заработало.
Осталось решить вопрос с дублированием сообщений в папке „Расписание“ и всё будет отлично.
Создается копия письма, далее созданная копия отправляется. Оригинальное письмо остается на месте без изменения. Никаких дублей.
Возможно, данная проблема возникает из-за отличий в версиях офиса или иных настройках Outlook. Проще будет, пожалуй, переписать макрос, чтобы в качестве исходного письма использовал не письмо в папке Outlook, а шаблон письма (.oft), сохраненный на ПК. На выходных напишу соответствующий макрос.
Я пока решил проблему просто убрав цикл перебора. Но хотелось бы конечно посмотреть на то, как это выглядит в профессиональном виде.
Private Sub Application_Reminder(ByVal Item As Object)
Dim OutFolder As Folder, NewItem As MailItem
If Item.Subject = «Рассылка писем 01» Then
Item.MarkComplete
'Set OutFolder = GetNamespace(«MAPI»).Folders(«Иванов Иван Иванович»).Folders(«Расписание»)
Set OutFolder = GetNamespace(«MAPI»).Folders(CStr(Session.Accounts.Item(1))).Folders(«Расписание»).Folders(«Расписание 01»)
Set OutFolder = GetNamespace(«MAPI»).Folders(CStr(Session.Accounts.Item(1))).Folders(«Расписание»).Folders(«Расписание 02»)
'перебираем письма в указанной папке
For i = 1 To OutFolder.Items.Count
'Debug.Print OutFolder.Items(i).Subject 'тема письма
Set NewItem = OutFolder.Items(i).Copy 'создаем копию письма
Call NewItem.Send 'отправляем письмо
Next i
End If
End Sub
Получается у меня есть главная папка Расписание, в ней подпапки Расписание 01(где 01 — это день месяца), в каждой дневной папке находится письмо, которое должно быть отправлено именно в этот день, грубо говоря разные письма в разные дни месяца, как подправить код?) Заранее спасибо!)
Подскажите где выбирать список адресатов?
Адресатов нужно указывать в поле получателей самого письма. Т.е. вы сохраняете шаблон письма с темой, текстом и набором получателей.
Суть работы макроса — создать копию письма и отправить в заданное время.
Макрос создает копию письма и отправляет в заданное время, а исходное письмо остается в папке «Расписание».
Подскажите, можно ли сделать, что бы исходные письма удалялись из папки «Расписание» после выполнения задания?
Было бы очень удобно таким образом контролировать, все ли письма были отправлены или какие то, по каким то причинам не отправились.
Да, макрос создает копию письма и исходное (он же шаблон письма) всегда остается в папке. Удалять исходные письма в текущей логике нет смысла, иначе макрос в следующий раз не найдет соответствующий шаблон и новое письмо не будет сформировано.
Лучше доработать макрос, чтобы он формировал некий лог в каком-либо текстовом файле. Тогда и логика работы макроса не будет нарушена и вы сможете отслеживать факт отправки нужных вам писем.
Сейчас же факт отправки письма вы всегда можете отследить по папке «Отправленные». Ведь если какое-либо письмо было отправлено, оно так или иначе окажется в этой папке.
Пишет: Sub or Function not defined
Это может быть связано с тем что у нас вся рабочая почта от gmail а аутлук просто как программа?
На сколько я знаю папки могут быть созданы напрямую а почте gmail а могут быть в аутлуке, и они там чем то отличаются
Пропущенная отправка(и) не состоятся?
Принцип работы макроса очень простой:
1. Происходит событие (задача)
2. Если макрос понимает, что сработала та самая задача, то запускает процесс копирования шаблонного письма и его отправку.
Нет, весь код макросов в данном случае пишется непосредственно в среде Outlook.
От себя хочу добавить тем у кого ошибка
Set OutFolder = GetNamespace(«MAPI»).Folders(CStr(Session.CurrentUser)).Folders(«Расписание»).
Вы не там создаете папку в аутлук. Надо создавать ее на верхнем уровне, не в подпапках. И все будет ок.
Темы писем будут разные.
Но вообще, судя по вашей задаче, надо убрать цикл:
For i = 1 To OutFolder.Items.Count
…
Next i
И вместо: Set NewItem = OutFolder.Items(i).Copy
Подставлять, например:
select case Weekday(Date(), vbMonday)
case 3: Set NewItem = OutFolder.Items(«Тема вашего письма 1»).Copy 'для среды
case 5: Set NewItem = OutFolder.Items(«Тема вашего письма 2»).Copy 'для пятницы
case else: exit sub
end select
Попробуйте.
Если не получится, напишите — чуть позже протестирую указанный код.
До этого, если письмо не отправлялось — срабатывало оповещение по задаче.
Глянула, что у Функция Weekday для среды значение 4, а для пятницы — 6.
Но это тоже не помогло…
И еще не пойму, Максим, как письмо в пятницу улетит, если в тексте только один день недели подставляем
select case Weekday(Date(), vbMonday)
Извиняюсь за тупые вопросы, я не программист…
Таким образом, срабатывает одна из ваших задач (в среду или пятницу), макрос определяет что это за день и исходя из дня (3 либо 5) запускает соответствующий блок кода из конструкции case.
И в макросе, обратите внимание, указан не один день, а два:
case 3:
case 5:
Нужно написать макрос, который будет отслеживать поступление новых писем. Этот макрос, в целом, очень простой и в интернете много примеров его написания. Это, пожалуй, самая сложная часть из всей реализации (хотя, как и сказал в предыдущем сообщении — макрос этот простой и в интернете много примеров).
Как только сработало событие (пришло новое письмо), макрос отправляет письмо в группу или на указанный емаил. Отправка письма делается также просто и в интернете много примеров.
Попробуйте начать писать макрос. Будут сложности или вопросы в процессе — спрашивайте, подскажу предметнее.
Прошу подсказать: у меня аутлук ругается на строчку в VBA на Set NewItem = OutFolder.Items(i).Copy 'создаем копию письма
Всё сделал по инструкции, но выбивает ошибку. Спасибо
Возможно, у вас что-то не корректно указано в строке:
Set OutFolder = GetNamespace(«MAPI»).Folders(«Иванов Иван Иванович»).Folders(«Расписание»)
Либо ящик задан не корректно либо папки «Расписание» нет.
Private Sub Application_Reminder(ByVal Item As Object)
Dim OutFolder As Folder, NewItem As MailItem
If Item.Subject = «Рассылка писем» Then
Item.MarkComplete
'Set OutFolder = GetNamespace(«MAPI»).Folders(«info@lag***»).Folders(«Расписание»)
Set OutFolder = GetNamespace(«MAPI»).Folders(CStr(Session.Accounts.Item(1))).Folders(«Расписание»)
'перебираем письма в указанной папке
For i = 1 To OutFolder.Items.Count
'Debug.Print OutFolder.Items(i).Subject 'тема письма
Set NewItem = OutFolder.Items(i).Copy 'создаем копию письма
Call NewItem.Send 'отправляем письмо
Next i
End If
End Sub
Ничего не понимаю в программировании, но настроить автоматическую отправку писем нужно. Может кто-то помочь? ????????
Обратитесь на один из сайтов по фрилансу. Возможно там вам смогут помочь за скромное вознаграждение.
Лично у меня очень мало свободного времени.
По разному бывает — зависит от настроек вашего Outlook. Где-то ФИО, где-то почта.
Здесь в комментариях вроде был код, который позволяет посмотреть существующие папки в Outlook. Можете им воспользоваться, если ручная подстановка не поможет.
Так на вскидку сложно что-то говорить и советовать.
Кто может помочь реализовать этот механизм?
Опишите задачу подробнее мне на почту: info@excelstore.pro
Подскажите, пожалуйста, как исправить ошибку.
А сама ошибка:
Run-time error '438'
Object doesn't support this property or method
Почему-то Item в данном случае не является объектом задачи либо он не определен.
Как вариант, когда появится данная ошибка и нажмете кнопку debug, то посмотри тип этой переменной командой: debug.print TypeName(Item)
Вы предлагали пример выше с использованием Select case в зависимости от темы письма, однако этот вариант у меня не работает (VBA ругается). Понять в чем причина не смог(
Если у вас будет время, помогите, пожалуйста, реализовать.
Пока я решил создать три папки для рассылки, в каждую засунуть свое письмо, создать три задачи и 3 макроса (понимаю, что это ламерский подход, но как сделать красивее, увы, понять не смог)/
В любом случае, огромное вам спасибо — перерыл весь интернет, но у вас все написано очень доступно и доходчиво!
Если еще актуально, то нужно смотреть в сторону — создать три разные задачи с разными темами. И в коде добавить условие (можно через Case), которое будет выдавать соответствующую тему на каждую задачу.
Или можно обойтись одной задачей и в коде подстановку нужной темы сделать исходя из дня недели. Т.е. есть одна задача, которая срабатывает 3 раза в неделю. Сработала задача, макрос понимает, что это, например, среда и подставляет нужную тему.
Второй вариант видится более практичным. Реализация что первого, что второго — не сложная.
Debug.Print OutFolder.Items(i).Subject = «тема письма»
верно я понял или другой формат?
Debug.Print выводит некие значения в окно Immediate.
Если хотите что-то задать, то указывать нужно без Debug.Print:
OutFolder.Items(i).Subject = «тема письма»
СУТЬ:
Есть файлик (формат не важен, но пусть будет xls)
в нем есть 3 столбца
1) данные 1
2) данные 2
3) ДАТА!!!
задача:
нужно чтобы (обработка или сторонний софт)
по условию
за 5 дней до даты,
за 1 день до даты
в день даты,
отправлял письмо на определенный эл. адрес.
в письмо включались данные из 1,2 и 3 столбца.
Ну и тему письма создавалась фраза + данные из 1 столбца
В папке расписание несколько писем с разными темами.
При срабатывании макрос создаются и отправляются копии писем всех шаблонов
с разными темами из папки расписание, а не одно с заданной темой.
В этой части кода видимо ошибка, поправьте пожалуйста.
For i= 1 To OutFolder.Items.Count
OutFolder.Items(i).Subject = «график вывоза» ' тема письма
Set NewItem = OutFolder.Items(i).Copy 'создаём копию письма
Call NewItem.Send ' отправляем письмо
Next i
Люди! Если у вас не получается, хотя бы пишите сразу какая ошибка у вас возникает.
На что вы надеетесь, оставляя сообщения вроде «УменяНичегоНеполучилосьЧтоделатьПомогите»?
Вот у меня (Outlook 365), например, почему-то не сработала строка:
Set OutFolder = GetNamespace("MAPI").Folders(CStr(Session.CurrentUser)).Folders("Scheduled mails")Ругалось, что не может найти папку с индексом по имени текущего пользователя ".Folders(CStr(Session.CurrentUser))".Под отладкой посмотрел, что папки в GetNamespace(«MAPI»).Folders нумеруются с 1.
В итоге, заработал такой вариант:
Set OutFolder = GetNamespace("MAPI").Folders(1).Folders("Scheduled mails")Отправленное письмо попадает в «Отправленные», исходный шаблон остается в нужной папке.И я переписал все на английский потому что в редакторе VBA до сих пор (уже 2023 год) проблемы с русской кодировкой при вставке текста из других приложений.
а к такому авто письму по расписанию может прикрепляется так же автоматически нужный файлик?
Папка «Расписание» есть, но письма не уходят, они переносятся в папку спама. В исходящих нет, в папке копии нет.
Не понял как добавлять письма в рассылку.
+1. Создайте задачу с именем «Рассылка писем».
+2. В параметрах задачи обязательно включите напоминание и задайте интервал повторений. Указанные дата и время напоминания — есть дата и время отправки писем.
+3. Создайте в Outlook папку с именем «Расписание». Все письма, которые требуется отправлять по графику размещайте в данной папке.
+4. Код скрипта из вложения выше разместите в модуле «ThisOutlookSession».
+5. В модуле VBA при необходимости создайте и добавьте персональный сертификат (на некоторых ПК возможна блокировка выполнения макросов без установленного сертификата).
--6 добавить письма в рассылку. Как это сделать? Как связать задачу и папку? Как запустить макрос на выполнение?