Outlook template rule to sort mails among directories

问题

I have folders created for different projects (e.g. Proj1, Proj2, Proj3, ...). It is general convention in the department to sent emails concerning specific project with its name in the subject (e.g. "Proj1: project finished!").

I know that I can create rules for every project to move mails that contain its name to the project folder. However, I would need to create as many rules as the number of folders I have - so its not very convenient and optimal.

Is there any way to create a rule (a single rule) (possibly, with VBA code) that will contain list of all folder names, search for any name from the list among mails' subjucts and automatically move mail to the corresponding folder?

回答1:

In order to achieve exactly what you want you can use this macro:

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

This macro can be triggered by arrival of a new email if you add to ThisOutlookSession module these lines:

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

Though, I would recommend you get rid of the folders where you move your messages to. Instead, you can use keep all you messages in Inbox and use Search folders to group them in whatever order you want. This way you can quickly search through all your inbox and sort it as well as separate search folders. You can also have the same message in different folders not duplicating it. If you decide to do so, your macro will need to assign categories instead of moving messages:

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

回答2:

I needed the rule to process subfolders, so I have slightly modified the previous answer of @Vladislav Andreev:

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

来源：https://stackoverflow.com/questions/32993611/outlook-template-rule-to-sort-mails-among-directories

标签

vba

outlook

outlook-2013