Outlook - макрос для создания папок

вопрос

Я очень часто получаю электронные письма, в заголовке которых есть «слово» в формате Issue-XXXX, где XXXX - это четырехзначное число. Я создал папку почтового ящика под названием проблемы. Я хотел бы, чтобы макросы находили все электронные письма со строкой формата Issue-XXXX в заголовке и искали папку с проблемами с тем же именем. Если он не найден, он должен быть создан. Затем электронная почта должна быть перемещена в эту подпапку.

Например, предположим, что в электронное письмо входит слово Issue-1234. Макрос при запуске (возможно, через панель инструментов) должен найти это электронное письмо и найти папку с именем Issue-1234 в папке вопросов и создать ее, если она не была найдена. Затем электронная почта должна быть перемещена в эту папку Issue-1234.

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

Решение

Файловые проекты в своих собственных подпапках

'Написано Брайсом Пеппером ( )

'Поиск субъекта для номера проекта M или Z (должен быть между 4-6 цифрами)

и помещает их в подпапку проекта (создайте папку, если она не существует)

добавлена поддержка проектов P & R 2009-03-03 B.Pepper

добавлена поддержка #, чтобы сделать Bill Z. счастливым 2009-03-04 B.Pepper

Вот код:

 Dim WithEvents objInboxItems в качестве Outlook.Items Dim objDestinationFolder в качестве Outlook.MAPIFolder Sub Application_Startup () Dim objNameSpace в качестве Outlook.NameSpace Установите objDestinationFolder = objInboxFolder.Parent.Folders ("Projects"). End Sub 'Запустите этот код, чтобы остановить правило. Sub StopRule () Set objInboxItems = Nothing End Sub 'Этот код является фактическим правилом. Private Sub objInboxItems_ItemAdd (элемент ByVal как объект) Dim objProjectFolder как Outlook. .Pattern = "([M, Z, P, R, #] d {4, 6})" Установить colMatches = objRegEx.Execute (Item.Subject), если colMatches.Count> 0, то для каждого myMatch в colMatches, если осталось $ (myMatch.Value, 1) = "#" Тогда folderName = "M" & Right $ ("00" & Mid $ (myMatch.Value, 2), 6) Иначе folderName = Left $ (myMatch.Value, 1) & Right $ ("00" & Mid $ (myMatch.Value, 2), 6) End If If FolderExists (objDestinationFolder, folderName) Затем установить objProjectFolder = objDestinationFolder.Folders (folderName) Иначе установить objProjectFolder = objDestinationFolder.Folders.Adddd. Конец Если Item.Move objProjectFolder Следующий Конец Если установлено objProjectFolder = Nothing Конец Подфункция FolderExists (parentFolder как MAPIFolder, folderName как строка) Dim tmpInbox As MAPIFolder при ошибке Перейти Перейти ndleError «Если папка не существует, в следующей строке будет ошибка». Эта ошибка приведет к тому, что обработчик ошибки перейдет к: handleError 'и пропустит возвращаемое значение True. Установите tmpInbox = parentFolder.Folders (folderName) FolderExists = True Функция выхода handleError: FolderExists = False End Function