Add all Outlook folders into an array - arrays

Question

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.

Answer 1

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.

Answer 2

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