I was recently helping out in an Experts-Exchange discussion in which the user needed to work with a custom Search Folder they had created.

Now normally, we could simply do something along the line of

Sub EnumerateFolder()
    Dim oOutlook              As Object    'Outlook.Application
    Dim oNameSpace            As Object    'Outlook.Namespace
    Dim oStores               As Object    'Outlook.Stores
    Dim oStore                As Object    'Outlook.Store
    Dim oFolders              As Object    'Outlook.folders
    Dim oFolder               As Object    'Outlook.folder

    On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")        'Bind to existing instance of Outlook
    If Err.Number <> 0 Then        'Could not get instance, so create a new one
        Err.Clear
        Set oOutlook = CreateObject("Outlook.Application")
    End If
    On Error GoTo Error_Handler
    Set oNameSpace = oOutlook.GetNamespace("MAPI")
    Set oStores = oNameSpace.Session.Stores
    For Each oStore In oStores
        Debug.Print oStore.DisplayName, oStore.FilePath, oStore.Class
        Set oRoot = oStore.GetRootFolder
        Debug.Print , oRoot.Name, oRoot.FolderPath
        Call EnumerateFolders(oRoot)
    Next
Error_Handler_Exit:
    On Error Resume Next
    If Not oFolder Is Nothing Then Set oFolder = Nothing
    If Not oFolders Is Nothing Then Set oFolders = Nothing
    If Not oStore Is Nothing Then Set oStore = Nothing
    If Not oStores Is Nothing Then Set oStores = Nothing
    If Not oNameSpace Is Nothing Then Set oNameSpace = Nothing
    If Not oOutlook Is Nothing Then Set oOutlook = Nothing
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: EnumerateFolder" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

Private Sub EnumerateFolders(ByVal oStartFolder As Object)
    'Modified from: https://docs.microsoft.com/en-us/office/vba/api/outlook.stores
    Dim oFolders               As Object 'Outlook.folders
    Dim oFolder                As Object 'Outlook.Folder

    On Error Resume Next

    Set oFolders = oStartFolder.folders

    If oFolders.Count > 0 Then
        For Each oFolder In oFolders
            Debug.Print , oFolder.Name, oFolder.FolderPath, oFolder.Class
            Call EnumerateFolders(oFolder)
        Next
    End If
    
    If Not oFolder Is Nothing Then Set oFolder = Nothing
    If Not oFolders Is Nothing Then Set oFolders = Nothing
End Sub

to enumerate the folders with Outlook, but if you do so, you’ll notice this method does not include such Search Folders!

Continue reading →