VBA如何递归遍历所有Outlook文件夹并将Folder对象存入数组？

问题原因 #

• 错误#91（对象变量或With块变量未设置）和Variant数组存储为字符串的核心原因是VBA中对象赋值必须使用Set关键字：
  • 你直接使用output(c) = SubFolder时，VBA会自动读取对象的默认属性返回值，Outlook.Folder的默认属性是Name，所以最终存入Variant数组的是文件夹名称字符串，而非Folder对象本身
  • 声明Outlook.Folder类型数组时，因为你没有用Set赋值，相当于给对象变量赋了字符串值，触发类型不匹配的91错误
• VBA数组完全支持存储对象类型，无论是Office内置对象还是自定义对象都没有限制，你之前看到的工作表对象存入数组的案例是正确的，只是你缺少Set关键字。

解决方法 #

以下两种实现方案可按需选择：

方案1：使用强类型Outlook.Folder数组（推荐，类型安全，有代码自动补全） #

递归遍历的完整函数示例如下：

' 函数返回Outlook.Folder类型数组，入参为要遍历的根Folder对象
Function GetAllSubFolders(ByVal rootFolder As Outlook.Folder) As Outlook.Folder()
    Dim tempList As Collection
    Set tempList = New Collection
    
    ' 递归遍历所有子文件夹
    Call RecurseFolder(rootFolder, tempList)
    
    ' 将集合转为强类型数组
    Dim output() As Outlook.Folder
    ReDim output(1 To tempList.Count)
    Dim i As Integer
    For i = 1 To tempList.Count
        Set output(i) = tempList(i)
    Next i
    GetAllSubFolders = output
End Function

' 递归辅助子过程
Private Sub RecurseFolder(ByVal currentFolder As Outlook.Folder, ByRef list As Collection)
    Dim subFolder As Outlook.Folder
    ' 先把当前文件夹加入集合（如果不需要包含根文件夹可以删掉下面这行）
    list.Add currentFolder
    ' 遍历所有子文件夹递归
    For Each subFolder In currentFolder.Folders
        Call RecurseFolder(subFolder, list)
    Next subFolder
End Sub

使用示例：

Sub TestGetFolders()
    Dim olApp As Outlook.Application
    Set olApp = New Outlook.Application
    Dim root As Outlook.Folder
    Set root = olApp.Session.GetDefaultFolder(olFolderInbox) ' 可以改成你需要的根文件夹
    
    Dim allFolders() As Outlook.Folder
    allFolders = GetAllSubFolders(root)
    
    ' 遍历验证
    Dim f As Outlook.Folder
    For Each f In allFolders
        Debug.Print f.Name, f.FolderPath ' 可以正常调用Folder对象的所有属性方法
    Next f
End Sub

方案2：使用Variant数组（兼容旧写法） #

只需要在赋值时加上Set关键字即可保留Folder对象：

' 原有代码修改版
Dim SubFolderCount As Integer
SubFolderCount = Folder.Folders.Count
Dim output() As Variant
ReDim output(SubFolderCount - 1) ' 注意数组下标从0开始的话要减1，避免下标越界
Dim c As Integer
c = 0
For Each SubFolder In Folder.Folders
    Set output(c) = SubFolder ' 加Set关键字，存入对象而非默认属性
    c = c + 1
Next SubFolder
GetSubfolders = output

取值的时候同样用Set接收对象即可：

Dim f As Outlook.Folder
Set f = output(0) ' 正常取到Folder对象

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