[SOLVED] Outlook template rule to sort mails among directories

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?

Solution

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