Outlook - макрос для створення папок

Проблема

Я часто надсилаю повідомлення електронної пошти, які мають "слово" у назві електронної пошти у форматі issue-xxxx, де xxxx - це 4-значний номер. Я створив папку поштової скриньки, на яку називаються проблеми. Я хотів би, щоб це зробити макрос, щоб знайти всі листи з рядком формату issue-xxxx в заголовку і шукати папку під питаннями з тим же ім'ям. Якщо не знайдено, то його треба створити. Після цього повідомлення електронної пошти потрібно перемістити до цієї підпапки.

Наприклад, припустимо, що електронна пошта надходить зі словом issue-1234. Під час запуску макросу (сподіваюся, за допомогою панелі інструментів) слід знайти цю адресу електронної пошти та перевірити папку під назвою issue-1234 під папкою Issues і створити її, якщо її не було знайдено. Після цього повідомлення електронної пошти потрібно перемістити в папку issue-1234.

Я ще не зробив жодного макро-програмування в минулому, тому будь-яка допомога про те, як почати роботу, буде оцінена. Якщо у вас є макрос, який робить це вже і хочете поділитися кодом, це буде ще краще.

Рішення

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

Автор Bryce Pepper

'Шукає тему для номера проекту M або Z (має бути між 4-6 цифрами)

і вносить їх у підпапку проекту (створити папку, якщо вона не існує)

'додана підтримка для проектів P & R 2009-03-03 B.Pepper

'додана підтримка для #, щоб зробити Bill Z. щасливим 2009-03-04 B.Pepper

Ось код:

 Dim WithEvents objInboxItems як Outlook.Items Розміряти об'єктна папку як Outlook.MAPIFolder Sub Application_Startup () Dim objNameSpace As Outlook.NameSpace Розмістити objInboxFolder як Outlook.MAPIFolder Встановити objNameSpace.GetDefaultFolder (olFolderInbox) Встановити objDestinationFolder = objInboxFolder.Parent.Folders ("Проекти") End Sub 'Запустити цей код, щоб зупинити ваше правило. Sub StopRule () Встановити objInboxItems = Nothing End Sub 'Цей код є фактичним правилом. Приватні підпрограми objInboxItems_ItemAdd (об'єкт ByVal як об'єкт) Dim objProjectFolder як Outlook.MAPIFolder Dim folderName As String set objRegEx = CreateObject ("VBScript.RegExp") objRegEx.Global = False 'Пошук предметів електронної пошти, які містять номер проекту (M007439, Z6312) .Pattern = "([M, Z, P, R, #] d {4, 6})" Встановити colMatches = objRegEx.Execute (Item.Subject) Якщо colMatches.Count> 0 Тоді для кожного myMatch In colMatches Якщо ліворуч $ (myMatch.Value, 1) = "#" Тоді folderName = "M" & Право $ ("00" & Mid $ (myMatch.Value, 2), 6) Ще folderName = Ліворуч $ (myMatch.Value, 1) & Право $ ("00" & Mid $ (myMatch.Value, 2), 6) Завершити Якщо If FolderExists (objDestinationFolder, folderName) Потім встановити objProjectFolder = objDestinationFolder.Folders (folderName) Else Set objProjectFolder = objDestinationFolder.Folders.Add (folderName) End If Item.Move objProjectFolder Наступний кінець Якщо встановлено objProjectFolder = Нічого не закінчиться Підфункція FolderExists (parentFolder As MAPIFolder, folderName As String) Dim tmpInbox Як MAPIFolder на помилку GoTo ha ndleError 'Якщо папка не існує, у наступному рядку буде помилка. Ця помилка призведе до того, що обробник помилок перейде до: handleError 'і пропустить значення True вертикального параметра Set tmpInbox = parentFolder.Folders (folderName) FolderExists = True Вихід з функції handleError: FolderExists = Функція помилкового завершення