Перенос письма outlook vba в другую папку

Обновлено: 07.07.2024

* Два способа переместить почтовый элемент в пользовательскую папку после отправки.

* Решение на клиентской стороне, не зависящее от поставщика почтового сервера.

* Лучшие способы распространения кода VBA среди пользователей.

Ограничения подхода на основе правил

Экран 1. Использование мастера Rules Wizard для применения правила к отправленным элементам

Экран 2. Диалоговое окно выбора папки для мастера правил

Экран 3. Диалоговое окно «Параметры ?почты»

Решение VBA: используем события Send почтового элемента

Разочаровавшись в правилах и параметрах, я засучил рукава, приготовил кофе и взялся за работу.

Куда поместить код?

Один из основных вопросов, которые приходится решать при проектировании управляемых событиями программ, заключается в поиске места для размещения кода обработки событий. В случае неправильного выбора программа может оказаться неустойчивой. Подходящих вариантов может быть несколько, но в большинстве случаев одно из мест лучше остальных.

Я вспомнил о событии ItemAdd() папки назначения. Оно возникает всегда, когда в коллекцию Items добавляется один или несколько элементов. Но по зрелом размышлении я понял, что этому событию свойственны те же проблемы временного согласования, что и событию MailItem_Send(). Кроме того, необходимо дублировать программный код для всех папок назначения. Дублировать исходный текст не годится, забудьте об этой идее.

Экран 4. Папки Outlook

Можно добраться до нужной папки с помощью кода:

BUSINESS_FOLDER — константа для имени папки. oBusinessFolder можно напрямую передать в подпрограмму MailItem.Move(), как требуется для объекта MAPIFolder. Аналогичным образом можно получить вложенную папку с помощью свойства коллекции Folders:

Set ObjFolder = Application.Session.GetDefaultFolder(olFolderInbox).Folders(" »)

Visual Basic Editor

Все приложения Microsoft Office поставляются с полнофункциональной средой разработки, именуемой Visual Basic Editor. Она обеспечивает интерфейс для доступа к объектным моделям приложения через программный код. В результате пользователь может вызывать методы объектов, задавать методы объектов и отвечать на события объектов. Для этих целей используется код VBA, особое подмножество языка Visual Basic.

Для доступа к Visual Basic Editor и другим инструментам разработки на ленте Office имеется вкладка Developer («Разработчик»). Но по умолчанию эта вкладка отключена, чтобы уменьшить уязвимость для вирусов и других вредоносных программ. Прежде чем воспользоваться этой вкладкой, необходимо выполнить следующие шаги.

1. В Outlook выберите Outlook Options («Параметры Outlook») на вкладке File («Файл»), чтобы открыть диалоговое окно Outlook Options.

2. В диалоговом окне Outlook Options нажмите кнопку Trust Center («Центр управления безопасностью»).

3. Щелкните Trust Center Settings («Параметры центра управления безопасностью»), а затем выберите параметр Macro Settings («Параметры макросов») слева.

4. Выберите удобный уровень безопасности Macro, с учетом того, что этот параметр влияет как на ваши, так и чужие макрокоманды. Если разрешить все макрокоманды, то Outlook будет отображать приглашение каждый раз при запуске макрокоманды. Таким образом, пользователь может решить, нужно ли запускать макрокоманду. Этот режим называется Notifications for all macros («Уведомления для всех макросов»).

5. Перезапустите Outlook, чтобы изменения вступили в силу.

Кнопка Visual Basic, которую мы видим на экране 5, находится на дальнем левом краю вкладки Developer. На экране 6 показан Visual Basic Editor.

Экран 5. Вкладка «Разработчик» с кнопкой Visual Basic

Экран 6. Visual Basic Editor с видимой областью проверки

Событие MailItem Send()

Чтобы события объекта были доступны в раскрывающемся списке Declarations («Объявления») в Visual Basic Editor (экран 7), нужно воспользоваться ключевым словом WithEvents для объявления объекта.

Экран 7. Раскрывающийся список «Объявления» в?Visual?Basic Editor

Следующие объявления объектов позволяют обратиться к событию MailItem Send():

Коллекция Inspectors содержит объекты Inspector для всех открытых инспекторов (то есть окно, в котором отображается информация об элементе Outlook). Ссылка на коллекцию Inspectors задается в событии Application_StartUp():

End Sub

Привязка oMsg к текущему инспектору

Inspector, переданный подпрограмме, имеет свойство CurrentItem, которое относится к элементу, просматриваемому пользователем. Проверив свойство Class этого элемента, можно определить, действительно ли это почтовый элемент. Для такой цели можно воспользоваться константой с именем olMail. Также необходимо проверить уникальную строку идентификатора, которую поставщик хранилища Messaging API (MAPI) назначает при создании элемента в хранилище. Поэтому свойство EntryID назначается элементу Outlook только после того, как элемент сохранен или отправлен. Эта проверка, выполняемая фрагментом кода с меткой A в листинге 1, отличает новые элементы электронной почты от существующих. Назначение почтового элемента таким способом приводит к возникновению его событий, в том числе события Send.

Событие oMsg_Send в действии

Экран 8. Пример вывода события oMsg_Send Event

Экран 9. Коллекция получателей MailItem

Экран 10. Проверка правила отправки

Альтернативное решение: использование события Items_ItemAdd папки Sent Items

Получение доступа к событию Items_ItemAdd() папки Sent Items

Событие ItemAdd() является членом объекта коллекции Items, поэтому необходимо использовать ключевое слово WithEvents в верхней части модуля ThisOutlookSession для объявления объекта типа Items:

Измененный код правила

Событие oSentItems_ItemAdd в действии

Экран 11. Пример события SentItems_ItemAdd

Экран 12. Проверка правила отправки для MailItems

Добавление других типов элементов не составляет труда; просто измените инструкцию If в Select Case и укажите целевые типы в списке с разделителями запятыми, как показано в листинге 4.

Запуск макрокоманды Move Sent MailItems по требованию

Простота и безопасность

Итак, в этой статье я рассказал о том, как использовать программный код VBA для расширения возможностей встроенных правил и параметров Outlook 2010. В частности, здесь показано два способа перемещения почтовых элементов в папку пользователя после отправки. Описанный метод гораздо безопаснее и проще многих решений, в которых применяются сложные процессы с временной синхронизацией, подверженные ошибкам вызовы Windows API или сторонние DLL-библиотеки. На клиентской стороне решение не зависит от поставщика почтового сервера и не привязано к Exchange Server. Более того, оно применимо для компании с любым количеством пользователей — от 50 до 5000.

Остается лишь найти оптимальный способ распространения кода VBA. Сделать это можно по-разному, причем в одних случаях требуется содействие пользователей, а в других можно действовать дистанционно:

* использовать команду File | Export (Файл | Экспорт) в VBA-среде Outlook для экспорта модулей как файлов. bas,. cls или. frm;

* копировать файл VbaProject.otm с компьютера, на котором были подготовлены макрокоманды, на компьютеры других пользователей, заменив существующий файл VbaProject.otm;

* использовать мастер Office Profile Wizard (Proflwiz.exe) для распространения проекта VBA.

Дополнительные материалы

«Microsoft Outlook Programming: Jumpstart for Administrators, Developers, and Power Users» Сью Мошер

Листинг 1. Код ThisOutlookSession для решения oMsg_Send

Листинг 2. Код ThisOutlookSession для решения Items_AddItem

Листинг 3. Программный код для обработки нескольких почтовых ящиков

Листинг 4: Программный код для добавления типов элементов

Автоматическое копирование вложений из писем в папку

Для автоматического копирования вложений из приходящих в Outlook писем в указанную папку можно воспользоваться правилом, исполняющим ниже прописанный скрипт VBA. Скрипт также модифицирует имя файла в соответствии с датой создания письма. Вариант из примера работает корректно для писем с одним вложением. Для писем с несколькими вложениями нужно изменить код в месте формирования имени файла.

Public Sub saveAttachtoDisk(itm As Outlook.MailItem) Dim objAtt As Outlook.Attachment Dim saveFolder As String dateOfMailItem = Format(itm.ReceivedTime, "yyyy.mm.dd") saveFolder = "C:\\Test" If Dir(saveFolder, vbDirectory) = "" Then MkDir saveFolder End If For Each objAtt In itm.Attachments 'Проверяем наличие файла с таким же именем j = " " For i = 1 To 1000 If Not Dir(saveFolder & "\" & dateOfMailItem & j & objAtt.FileName) = "" Then j = "_" & i & "_" Else Exit For End If Next i 'Конец проверки objAtt.SaveAsFile saveFolder & "\" & dateOfMailItem & j & objAtt.FileName Set objAtt = Nothing Next End Sub

Решение проблем

Если часть созданного правила выполняется, но сам скрипт не срабатывает, то, возможно, дело в настройках безопасности Outlook 2010/2013/2016 (в Outlook 2007 и старше эта опция находится в Tools -> Macro Security). Чтобы макрос сработал:

Обработка msg-вложений

Ниже пример кода, который сохраняет каждое вложение из письма в папку с названием, совпадающим с темой письма. Если вложенные файлы сами являются письмами (т.е. имеют расширение *.msg), то сохраняются только вложения из них в подпапку с названием таким же, как тема вложенного *.msg файла.
Чтобы код работал нужно включить Microsoft Scripting Runtime как описано в другой статье.

Sub saveAttachtoDisk(itm As Outlook.MailItem) Dim objAtt As Outlook.Attachment Dim objAttachments As Outlook.Attachment Dim saveFolder As String Dim openMsg As MailItem dateOfMailItem = Format(itm.ReceivedTime, "yyyy.mm.dd") saveFolder = "C:\Test\" If Dir(saveFolder, vbDirectory) = "" Then MkDir saveFolder End If For t = 1 To Len(itm.Subject) s = Mid(itm.Subject, t, 1) If Not LCase(s) Like "[?/\|*<>:]" Then sSubject = sSubject & s End If Next t For Each objAtt In itm.Attachments saveFolderFull = saveFolder & sSubject If Dir(saveFolderFull, vbDirectory) = "" Then MkDir saveFolderFull End If 'Проверяем наличие файла с таким же именем j = " " For i = 1 To 1000 If Not Dir(saveFolderFull & "\" & dateOfMailItem & j & objAtt.FileName) = "" Then j = "_" & i & "_" Else Exit For End If Next i 'Конец проверки objAtt.SaveAsFile saveFolderFull & "\" & dateOfMailItem & j & objAtt.FileName 'Из msg файлов достаём вложения и удаляем If LCase(Right(objAtt.FileName, 4)) = ".msg" Then Set openMsg = Application.CreateItemFromTemplate(saveFolderFull & "\" & dateOfMailItem & j & objAtt.FileName) sSubject2 = "" For t = 1 To Len(openMsg.Subject) s = Mid(openMsg.Subject, t, 1) If Not LCase(s) Like "[?/\|*<>:]" Then sSubject2 = sSubject2 & s End If Next t If Dir(saveFolderFull & "\" & sSubject2, vbDirectory) = "" Then MkDir saveFolderFull & "\" & sSubject2 End If 'Сохраняем вложения из msg-файла For Each objAttachments In openMsg.Attachments objAttachments.SaveAsFile saveFolderFull & "\" & sSubject2 & "\" & dateOfMailItem & objAttachments.FileName Next openMsg.Close olDiscard Kill saveFolderFull & "\" & dateOfMailItem & j & objAtt.FileName 'Удаляем файл msg-файла End If Set objAtt = Nothing Next End Sub

Сохранение письма с вложениями на диск

Если нужно сохранить само письмо, а не только вложения, то код упрощается:

Читайте также: