将所有 Outlook 文件夹添加到一个数组中

Question

我想递归地遍历我所有的 outlook 文件夹，将它们添加到一个数组中，然后 return 它带有一个函数，这样我就可以从多个地方调用它。

我需要添加的对象类型是Outlook.Folder，所以我从
开始 Dim output() As Outlook.Folder
这给了我一连串的错误#91。

我发现我可以声明数组
Dim output() As Variant
按以下顺序工作：

Dim SubFolderCount As Integer
SubFolderCount = Folder.Folders.Count
Dim output() As Variant
ReDim output(SubFolderCount)
Dim c As Integer
c = -1
'Debug.Print Folder.Name
'GetSubfolders = Folder.Folders.Count
For Each SubFolder In Folder.Folders
    c = c + 1
    output(c) = SubFolder
    'GetSubfolders = GetSubfolders + GetSubfolders(SubFolder)
Next SubFolder
GetSubfolders = output

我发现我添加到这个 Variant 数组的任何内容都变成了类型 Variant/String。

为了确定，我 return 从我的函数中编辑了那个数组，遍历了结果并确保我不能将数组内容用作 Outlook.Folder 类型，我只能使用它作为 String.

是否可以只将基元分配到数组中？

我很确定我看过他们添加工作表的示例。

Answer 1

您错过了“设置”：

set output(c) = SubFolder

也就是说，我宁愿存储文件夹条目 ID（字符串）并使用 Namespace.GetFolderFromID 按需打开文件夹。处理文件夹后，您可以通过将其设置为 Nothing.

来释放它

Answer 2

此代码使用字典来存储本地文件夹名称和路径

Sub RecurseFolderStructure()
    ' Requires Reference: Microsoft Scripting Runtime

    Dim ThisNamespace As Outlook.NameSpace: Set ThisNamespace = Application.GetNamespace("MAPI")
    Dim Inbox As Outlook.MAPIFolder: Set Inbox = ThisNamespace.GetDefaultFolder(olFolderInbox)
    'Dim Cal As Outlook.MAPIFolder: Set Cal = ThisNamespace.GetDefaultFolder(olFolderCalendar)
    Dim Junk As Outlook.MAPIFolder: Set Junk = ThisNamespace.GetDefaultFolder(olFolderJunk)

    Dim BaseFolder As Outlook.MAPIFolder: Set BaseFolder = Inbox '.Folders("SubFolder1\SubFolder2...")
    Dim Folders As Scripting.Dictionary: Set Folders = New Scripting.Dictionary
    AddSubFolders BaseFolder, Folders

    Dim f As Outlook.MAPIFolder

    Dim Key As Variant
    For Each Key In Folders
        'Further Code; for eg.
        Set f = Folders(Key)
        Debug.Print f.FolderPath
    Next Key

    Folders.RemoveAll
    Set Folders = Nothing
End Sub

Function AddSubFolders(ByRef CurrentFolder As Outlook.MAPIFolder, ByRef dict As Scripting.Dictionary)
    Dim Folder As Outlook.MAPIFolder
    If Not dict.Exists(CurrentFolder.FolderPath) Then dict.Add CurrentFolder.FolderPath, CurrentFolder

    If CurrentFolder.Folders.Count > 0 Then
        For Each Folder In CurrentFolder.Folders
            AddSubFolders Folder, dict
        Next
    End If
End Function

将所有 Outlook 文件夹添加到一个数组中

Add all Outlook folders into an array

arrays

outlook

vba