Outlook VBA如何为指定ExchangeStoreType的账户运行邮件规则

核心逻辑是在存储遍历环节增加类型判断，仅对ExchangeStoreType为0、4的存储执行规则调用，同时修正原代码中无差别容错的问题，避免异常被静默吞掉。

核心改动点 #

• 单独维护目标存储类型数组，后续调整筛选条件无需修改核心遍历逻辑
• 遍历每个存储时先做类型校验，不匹配直接跳过后续逻辑
• 缩小On Error Resume Next的作用范围，仅在调用GetRules()这类可能因存储权限/类型不匹配报错的位置开启容错
• 增加对象有效性校验，避免未正确获取规则对象时触发空引用错误

完整修改后代码 #

Sub RunTest()
    Dim storeRules As Outlook.Rules
    Dim storeRule As Outlook.Rule
    Dim allStores As Outlook.Stores
    Dim myStore As Outlook.Store
    ' 可按需调整需要执行规则的存储类型
    Const TARGET_TYPE_EXCHANGE_USER As Long = 0
    Const TARGET_TYPE_EXCHANGE_ONLINE As Long = 4
    Dim targetTypes As Variant
    
    targetTypes = Array(TARGET_TYPE_EXCHANGE_USER, TARGET_TYPE_EXCHANGE_ONLINE)
    Set allStores = Application.Session.Stores
    
    For Each myStore In allStores
        ' 匹配目标类型才进入后续逻辑
        If IsTargetStore(myStore.ExchangeStoreType, targetTypes) Then
            Debug.Print "开始处理存储: " & myStore.DisplayName & " | 类型值: " & myStore.ExchangeStoreType
            ' 仅在获取规则时开启容错，避免非目标存储调用GetRules报错
            On Error Resume Next
            Set storeRules = myStore.GetRules()
            On Error GoTo 0 ' 立刻关闭容错，避免后续错误被隐藏
            
            ' 确认规则对象获取成功后再执行
            If Not storeRules Is Nothing Then
                For Each storeRule In storeRules
                    storeRule.Execute ShowProgress:=True
                Next
                ' 释放规则对象，避免跨存储引用残留
                Set storeRules = Nothing
            End If
        End If
    Next
End Sub

' 辅助校验函数：判断当前存储类型是否在目标范围内
Function IsTargetStore(storeType As Long, targetTypeArr As Variant) As Boolean
    Dim typeItem As Variant
    For Each typeItem In targetTypeArr
        If typeItem = storeType Then
            IsTargetStore = True
            Exit Function
        End If
    Next
    IsTargetStore = False
End Function

效果说明 #

运行后会自动过滤掉日志中类型为1（本地缓存/非Exchange）、2（公共文件夹）的存储，仅执行类型为0、4的账户下的规则，和调试日志的输出完全匹配。

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