用于在目录之间对邮件进行排序的 Outlook 模板规则

Outlook template rule to sort mails among directories

我为不同的项目(例如 Proj1、Proj2、Proj3 等)创建了文件夹。 部门的一般惯例是发送有关特定项目的电子邮件,并在主题中注明其名称(例如 "Proj1: project finished!")。

我知道我可以为每个项目创建规则,将包含其名称的邮件移动到项目文件夹。但是,我需要创建与我拥有的文件夹数量一样多的规则 - 所以它不是很方便和优化。

有什么方法可以创建一个规则(单个规则)(可能使用 VBA 代码),它将包含所有文件夹名称的列表,从邮件主题列表中搜索任何名称,然后自动将邮件移动到相应的文件夹?

为了实现您想要的效果,您可以使用这个宏:

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

我需要规则来处理子文件夹,所以我稍微修改了@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