Outlook 2016 vba Application.Session.DefaultStore.GetRules（）不返回规则

Question

我有一个outlook宏，它具有检索规则的代码，适用于Outlook 2013，但不适用于运行Outlook 2016的另一台机器。

代码是：

    Set colRules = Session.DefaultStore.GetRules()

    For Each oRule In colRules
        ruleName = oRule.Name
        If Left(ruleName, 21) = "AutoCategorize into *" Then
            oRule.Execute (True)
        End If
    Next

根据我的调试问题，在返回的colRules对象中。 在2016年，它显示它有26个项目，但不包含： (debug view image in 2016)

在Outlook 2013上，同一个对象显示所有26个项目（规则）： (debug view image in 2013)

其他观察结果：

• 规则向导确实在两台计算机上正确显示了所有26条规则;
• 某些规则是在运行Outlook 2013的计算机上定义的，因此它们在2016规则向导中显示为（对于其他计算机）;
• OutlookSpy商店 - ＆gt;功能 - ＆gt; GetRules返回相同的结果:(无法发布图片但信誉不足）

编辑 - 我找到了问题的原因，但不是解决方案...... 事情不起作用的原因是规则对象包含来自另一台计算机的规则＆＃39;。 我删除了另一台计算机上标记的所有规则＆＃39;测试，并重新运行宏。现在它确实找到了所有剩余的规则。对于OutlookSpy也是如此。因此，微软的规则实施中出现了一些问题。当然我不能保持这样，因为它是一个交换邮箱，它实际上也从其他计算机中删除了规则...... 我在另一个帐户上测试了这个并得到了相同的结果，这证明了outlook API无法处理规则。有没有人有任何替代解决方案或解决方法？ @Dmitry？

Answer 1

请尝试下面我创建的宏，经过一番努力，帮助我了解我的Outlook 2016安装中的规则，因为它们不在我认为的位置。

除了我的两个商店之外的所有商店都会生成以下消息：“440此商店不支持规则。无法完成操作。“对于所有这些存储，规则都在默认存储”outlook数据文件“中。但是一家商店包含自己的规则。

使用我的Outlook安装，具有自己规则的商店的扩展名为“OST”，表示它是一个脱机商店。 “Outlook数据文件”和所有其他商店的扩展名为“PST”。

我想知道这个宏为你生成了什么。您的规则是否在OST商店中，而不是您期望的默认商店？

Public Sub DemoRules()

  Dim ColRules As Outlook.Rules
  Dim ErrDesc As String
  Dim ErrNum As Long
  Dim InxStoreCrnt As Long
  Dim RuleCrnt As Outlook.Rule

  With Session
    For InxStoreCrnt = 1 To .Stores.Count
      With .Stores(InxStoreCrnt)
        Debug.Print .DisplayName
        Set ColRules = Nothing
        On Error Resume Next
        Set ColRules = .GetRules()
        ErrNum = Err.Number
        ErrDesc = Err.Description
        On Error GoTo 0
        If ErrNum <> 0 Then
          Debug.Print "  " & ErrNum & " " & ErrDesc
        Else
          If Not ColRules Is Nothing Then
            If ColRules.Count = 0 Then
              Debug.Print "  no rules in this store"
            Else
              For Each RuleCrnt In ColRules
                Debug.Print "  " & RuleCrnt.Name
              Next
            End If
          Else
            Debug.Print " No error but GetRules returned Nothing"
          End If
        End If
      End With
      Set ColRules = Nothing
    Next
  End With

End Sub