CODEWITHSUNDEEP
arraysvbaoutlook
Jan Kadera
Jan Kadera

Reputation: 91

Add all Outlook folders into an array

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.

Upvotes: 1

Views: 442

Answers (2)

Tragamor
Tragamor

Reputation: 3634

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

Upvotes: 0

Dmitry Streblechenko
Dmitry Streblechenko

Reputation: 66266

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.

Upvotes: 1

Related Questions