Outlook VBA填充嵌套文件夹至ComboBox时出错（错误-2147221233）

错误根源 #

1. 账户定位错误：ns.Folders("**email@email.co.uk**") 使用邮箱地址索引账户是错误的，Outlook的NameSpace.Folders集合是按账户的显示名称（如"John Doe"）而非邮箱地址检索的，导致找不到收件箱对象。
2. 未遍历多层嵌套文件夹：原CheckSubfolders仅处理传入文件夹的直接子文件夹，没有递归深入下一层，无法定位到深层的目标文件夹。
3. 后缀判断逻辑漏洞：Mid函数判断后缀时，若文件夹名称长度不足指定长度会触发隐性错误，且逻辑不够直观。

修正后的代码 #

Private Sub UserForm_Initialize()
    On Error GoTo ErrorHandler
    Dim ns As Outlook.NameSpace
    Dim inbox As Outlook.Folder
    Dim targetParentFolder As Outlook.Folder

    Set ns = Application.GetNamespace("MAPI")
    ' 优先用默认收件箱，若需指定非默认账户，替换为账户显示名称（如"John Doe"）
    Set inbox = ns.GetDefaultFolder(olFolderInbox)
    ' 非默认账户写法示例：Set inbox = ns.Folders("你的账户显示名称").Folders("Inbox")
    
    ' 定位到2023文件夹，确保路径与Outlook中完全一致
    Set targetParentFolder = inbox.Folders("PENIEL GREEN N.HOME").Folders("2023")
    ' 递归遍历所有嵌套子文件夹
    CheckSubfolders targetParentFolder

    If ComboBox1.ListCount > 0 Then
        ComboBox1.ListIndex = 0
    End If

    If ComboBox2.ListCount > 0 Then
        ComboBox2.ListIndex = 0
    End If

    Exit Sub

ErrorHandler:
    MsgBox "Error: " & Err.Number & " - " & Err.Description
End Sub

Private Sub CheckSubfolders(currentFolder As Outlook.Folder)
    Dim subfolder As Outlook.Folder
    
    ' 先检查当前文件夹是否符合后缀要求
    If Right(currentFolder.Name, 8) = "PGNH Rx" Then
        ComboBox1.AddItem currentFolder.Name
    ElseIf Right(currentFolder.Name, 11) = "PGNH Triage" Then
        ComboBox2.AddItem currentFolder.Name
    End If
    
    ' 递归遍历所有子文件夹，覆盖多层嵌套场景
    For Each subfolder In currentFolder.Folders
        CheckSubfolders subfolder
    Next
End Sub

关键修改说明 #

• 修正账户定位：用GetDefaultFolder(olFolderInbox)获取默认收件箱，非默认账户则替换为账户显示名称（可在Outlook账户设置中查看）。
• 递归遍历逻辑：修改CheckSubfolders参数为单个文件夹对象，先检查当前文件夹，再递归处理所有子文件夹，确保覆盖所有嵌套层级。
• 优化后缀判断：使用Right函数直接截取末尾对应长度的字符，避免因名称过短引发的错误，逻辑更清晰可靠。

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