Ошибка выполнения: установите olRule = olRules.Item(i) после обновления Microsoft, где правила настроены как «Через указанную учетную запись»

ОШИБКА: 2020.05.26 — с момента последнего обновления Microsoft код не работает при настройке правил как «Через указанную учетную запись».

Когда он ударит

Set olRule = olRules.Item(i)

он выдает:

Ошибка времени выполнения '-2146664191 [800c8101]

Private Function FindRule(strRuleName As String) As Boolean
     'error handler
    On Error GoTo ErrorHandler
    
    'default process boolean to failed
    FindRule = False
         
    'open rules object
    Set olRules = Outlook.Application.Session.DefaultStore.GetRules

    'loop through rules to see if the rule is in the rules list    
    If olRules.Count = 0 Then
    'no rules, so it can't exist
        FindRule = False
    Else
    'check the list of rules
        'For i = olRules.Count To 1 Step -1
        For i = 1 To olRules.Count
            Set olRule = olRules.Item(i)
            If olRule.Name = strRuleName Then
                FindRule = True
                Exit For
            End If
        Next i
    End If
    
    'rule not found. let folks know
    If FindRule = False Then
        Err.Raise 60001, "Rule Error", "Rule not found!"
    End If
    
ExitFunction:
    'skip error handler
    Exit Function
    
ErrorHandler:
    'display error
    MsgBox Err.Description, vbExclamation + vbOKCancel, "FindRule - Error: " & CStr(Err.Source)
    'clear error
    Err.Clear
    'return failed boolean
    FindRule = False

End Function

OnError Resume Next не позволяет продолжить выполнение.

Удаление правила «Через указанную учетную запись» позволяет выполнить код.