Outlook VBA实现邮件自动分类 补全Array0条件及数组化改造咨询

需求匹配逻辑说明 #

需实现的判断优先级如下：

若邮件主题包含Array0（#G126A/#G156A/#G186B/#GA265/#GH264A）中任意值，直接退出不分类
若主题包含Array1中任意值，标记分类为CAT1
若主题包含Array2中任意值，标记分类为CAT2
若主题包含Array3中任意值，标记分类为CAT3
若主题包含Array4中任意值，标记分类为CAT4

代码修改操作 #

1. ThisOutlookSession 代码无需调整 #

原有事件监听逻辑完全符合需求，直接保留现有代码即可。

2. 普通模块 AutoCategorize 代码完整替换 #

将原有普通模块中的代码替换为下方优化后的版本：

Public Sub AutoCategorize(olItem As MailItem)
    ' 定义各分类关键词数组
    Dim arrIgnore, arrCat1, arrCat2, arrCat3, arrCat4
    arrIgnore = Array("#G126A", "#G156A", "#G186B", "#GA265", "#GH264A")
    arrCat1 = Array("100001", "103401", "108401", "800899", "800795", "800755", "800617", "850519", "212485")
    arrCat2 = Array("800880", "221315", "004083", "218713", "800824", "004131", "800404", "020082", "212445")
    arrCat3 = Array("215007", "215989", "005306", "004025", "060068", "060193", "030002", "060103", "217811")
    arrCat4 = Array("060001", "215720", "030001", "030445", "030388", "030070", "060065", "601003", "203093")
    
    ' 优先匹配忽略数组，匹配到直接退出
    If IsSubjectMatch(olItem.Subject, arrIgnore) Then
        GoTo lbl_Exit
    End If
    
    ' 依次匹配各分类数组
    If IsSubjectMatch(olItem.Subject, arrCat1) Then
        olItem.Categories = "CAT1"
    ElseIf IsSubjectMatch(olItem.Subject, arrCat2) Then
        olItem.Categories = "CAT2"
    ElseIf IsSubjectMatch(olItem.Subject, arrCat3) Then
        olItem.Categories = "CAT3"
    ElseIf IsSubjectMatch(olItem.Subject, arrCat4) Then
        olItem.Categories = "CAT4"
    Else
        ' 无匹配分类，不操作
        GoTo lbl_Exit
    End If
    
    ' 匹配成功则保存修改
    olItem.Save
    
lbl_Exit:
    Exit Sub
End Sub

' 通用匹配函数：判断主题是否包含数组中任意关键词
Private Function IsSubjectMatch(subject As String, keyArr As Variant) As Boolean
    Dim key
    IsSubjectMatch = False
    For Each key In keyArr
        ' vbTextCompare表示不区分大小写匹配，如需区分可改为vbBinaryCompare
        If InStr(1, subject, key, vbTextCompare) > 0 Then
            IsSubjectMatch = True
            Exit Function
        End If
    Next
End Function

优化说明 #

• 修复了原有代码中myitem未定义的变量错误，统一使用传入的olItem邮件对象
• 所有关键词均采用数组存储，后续新增/删除/修改关键词只需调整对应数组的元素即可，无需修改判断逻辑
• 新增通用匹配函数，减少重复代码，默认开启不区分大小写匹配，可根据需要自行调整匹配规则
• 部署完成后需重启Outlook，或手动运行ThisOutlookSession中的Application_Startup过程激活新邮件监听事件

内容的提问来源于stack exchange，提问作者Kurt Lehder