Правило шаблона Outlook для сортировки писем среди каталогов

Question

У меня есть папки, созданные для разных проектов (например, Proj1, Proj2, Proj3, ...). Это общая конвенция в отделе для отправки электронных писем по конкретному проекту с его именем в теме (например, «Proj1: проект завершен!»).

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

Есть ли способ создать правило (единственное правило) (возможно, с кодом VBA), которое будет содержать список всех имен папок, поиск любого имени из списка среди почтовых отправлений и автоматическое перемещение почты на соответствующая папка?

Answer 1

Для того, чтобы достичь именно то, что вы хотите, вы можете использовать этот макрос:

Sub RulesForFolders(m As MailItem) 
Dim fldr As Outlook.Folder 
For Each fldr In GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders 
    If m.Subject Like "*" & fldr.Name & "*" Then m.Move fldr 
Next 
Set fldr = Nothing 
End Sub 

Этот макрос может быть вызван приходом новой электронной почты, если вы добавите к ThisOutlookSession модуля этих строк:

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String) 
Dim o As Object 
Set o = Application.Session.GetItemFromID(EntryIDCollection) 
If TypeName(o) = "MailItem" Then RulesForFolders o 
Set o = Nothing 
End Sub 

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

Sub RulesForFolders(m As MailItem) 
Dim fldr As Outlook.Folder, str As Outlook.Store 
For Each str In Application.Session.Stores 
    For Each fldr In str.GetSearchFolders 
     If m.Subject Like "*" & fldr.Name & "*" Then 
      m.Categories = m.Categories & "," & fldr.Name 
      m.Save 
     End If 
    Next 
Next 
Set fldr = Nothing 
Set str = Nothing 
End Sub 

Answer 2

мне нужно было правило обрабатывать вложенные папки, так что я немного изменил предыдущий ответ @Vladislav Андреев:

Sub RulesForFolders(m As MailItem) 
    Dim fldr As Outlook.Folder 
    For Each fldr In GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders 
     If LCase(m.Subject) Like "*" & LCase(fldr.Name) & "*" Then 
      m.Move fldr 
      Exit For 
     End If 
     For Each subFldr In fldr.Folders 
      If LCase(m.Subject) Like "*" & LCase(subFldr.Name) & "*" Then 
       m.Move subFldr 
       Exit For 
      End If 
     Next 
    Next 
    Set fldr = Nothing 
    Set subFldr = Nothing 
End Sub