Outlook宏For Each循环触发“Automation Error = For Loop not Initialized”问题求助

问题场景 #

• 需求：用按钮一键运行所有Outlook收件箱规则
• 异常：仅能执行第一个名为「MKG」的规则，走到Next语句时触发运行时错误-2146664191(800c8101)（Automation Error）；注释掉On Error Resume Next后，直接弹出「Automation error - Loop not initialised」错误
• 环境差异：同版本（Outlook 2019 Desktop+Windows 10 Pro）的电脑运行该宏完全正常；自己电脑能正常运行无循环的Outlook宏，但所有带循环（For Each/Next、Do Until/Loop等）的宏都会触发「Automation Error = For Loop not Initialized」错误，怀疑系统或Office文件损坏
• 原问题宏代码：

Sub RunAllInboxRules()
Dim st As Outlook.Store
Dim myRules As Outlook.Rules
Dim rl As Outlook.Rule
Dim count As Integer
Dim ruleList As String

On Error Resume Next
    
' 获取默认存储区（规则存放位置）
Set st = Application.Session.DefaultStore

' 获取规则集合
Set myRules = st.GetRules

    ' 遍历所有规则
For Each rl In myRules
    ' 判断是否为收件箱规则
        If rl.RuleType = olRuleReceive And rl.IsLocalRule = True Then
     ' 若是则执行规则
        rl.Execute ShowProgress:=True
        count = count + 1
        ruleList = ruleList & vbCrLf & rl.name
    End If
  Next

' 告知用户执行结果
ruleList = "已针对收件箱执行以下规则: " & vbCrLf & ruleList
MsgBox ruleList, vbInformation, "宏: RunAllInboxRules"

Set rl = Nothing
Set st = Nothing
Set myRules = Nothing
End Sub

排查与修复步骤 #

1. 修复Office安装文件 #

• 打开「控制面板」→「程序和功能」，找到Microsoft Office 2019
• 右键选择「更改」，先尝试「快速修复」，完成后重启电脑测试；若无效，再选择「联机修复」（需联网）

2. 重置Outlook配置文件 #

• 关闭Outlook，打开「控制面板」→「邮件」→「显示配置文件」
• 新建一个配置文件，添加你的邮件账户并设为默认配置文件，启动Outlook后重新导入规则，再运行宏测试

3. 重新注册Outlook COM组件 #

• 以管理员身份打开CMD命令提示符，执行以下命令（注意路径需匹配你的Office安装位置，32位Office在Program Files (x86)目录下）：

regsvr32.exe "C:\Program Files\Microsoft Office\Root\Office16\OUTLOOK.EXE"
regsvr32.exe "C:\Program Files\Microsoft Office\Root\Office16\MSOUTL.OLB"

• 执行成功后弹出注册提示，重启Outlook测试

4. 清理Outlook缓存 #

• 关闭Outlook，删除%LOCALAPPDATA%\Microsoft\Outlook路径下的缓存文件
• 重启Outlook后再运行宏

5. 检查VBA信任设置 #

• 打开Outlook，按Alt+F11打开VBA编辑器
• 依次点击「工具」→「选项」→「安全性」→「宏安全性」，勾选「信任对VBA项目对象模型的访问」，重启Outlook测试

优化后的宏代码（添加单规则错误捕获） #

如果修复后仍有个别规则执行失败，可使用此版本，捕获单个规则的错误，避免中断整个循环：

Sub RunAllInboxRules()
    Dim st As Outlook.Store
    Dim myRules As Outlook.Rules
    Dim rl As Outlook.Rule
    Dim count As Integer
    Dim ruleList As String
    Dim errorList As String

    ' 获取默认存储区
    Set st = Application.Session.DefaultStore
    ' 获取规则集合
    Set myRules = st.GetRules

    ' 遍历所有规则
    For Each rl In myRules
        If rl.RuleType = olRuleReceive And rl.IsLocalRule = True Then
            On Error Resume Next
            rl.Execute ShowProgress:=True
            If Err.Number <> 0 Then
                errorList = errorList & vbCrLf & rl.Name & " - 执行失败: " & Err.Description
                Err.Clear
            Else
                count = count + 1
                ruleList = ruleList & vbCrLf & rl.Name
            End If
            On Error GoTo 0
        End If
    Next

    ' 显示执行结果
    ruleList = "已执行的收件箱规则:" & vbCrLf & ruleList
    If errorList <> "" Then
        ruleList = ruleList & vbCrLf & vbCrLf & "执行失败的规则:" & errorList
    End If
    MsgBox ruleList, vbInformation, "宏: RunAllInboxRules"

    ' 释放对象
    Set rl = Nothing
    Set st = Nothing
    Set myRules = Nothing
End Sub

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