Add all Outlook folders into an array-CodePudding

I would like to recursively go through all my outlook folders, add them into an array and return it with a function, so I can call it from multiple places.

Type of object I need to add is Outlook.Folder, so I started with
Dim output() As Outlook.Folder
which provided me with a streak of error #91.

I found I can declare arrays
Dim output() As Variant
which worked in the following sequence:

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

I found whatever I added to this Variant array is turned to type Variant/String.

Just to be sure, I returned that array from my function, looped through the result and made sure that I cannot use the array contents as Outlook.Folder type, I can only use it as String.

Is it possible, that only primitives can be assigned into an array?

I'm pretty sure I've seen examples where they were adding worksheets.

CodePudding user response：

You missed "set":

set output(c) = SubFolder

That being said, I'd rather store folder entry ids (string) and open the folders on demand using Namespace.GetFolderFromID. Once a folder is processed, you can release it by setting it to Nothing.

CodePudding user response：

This code uses a dictionary to store the local folder name and path

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