VBA – Outlook – Work With Search Folders

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!

So I went digging, and found mention of GetSearchFolder. Of course it wasn’t until I had managed to get a functional procedure that I knew enough of what to search for that I could locate the official documentation, refer to https://docs.microsoft.com/en-us/office/vba/api/outlook.store.getsearchfolders.

All that said, below is a sample procedure that demonstrates how you can bind to a specific Search Folder and extract information

'---------------------------------------------------------------------------------------
' Procedure : EnumerateSearchFolderItems
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Demonstration sub to illustrate how one can bind and work with the items
'               in an Outlook Search Folder
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sSearchFolderName : The name of the Search Folder you wish to work with
'
' Usage:
' ~~~~~~
' Call EnumerateSearchFolderItems("YourSearchFolderName")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2019-06-18              Initial Release (Forum Help)
'---------------------------------------------------------------------------------------
Sub EnumerateSearchFolderItems(ByVal sSearchFolderName As String)
    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 oFolder               As Object    'Outlook.folder
    Dim i                     As Long

    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
        Set oFolder = oStore.GetSearchFolders.Item(sSearchFolderName)
        If Not oFolder Is Nothing Then
            With oFolder.items
                For i = 1 To .Count
                    Debug.Print i, .Item(i).SenderName, .Item(i).Subject, .Item(i).ReceivedTime, .Item(i).Categories
                Next i
            End With
            Exit For
        End If
    Next
Error_Handler_Exit:
    On Error Resume Next
    If Not oFolder Is Nothing Then Set oFolder = 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: EnumerateSearchFolderItems" & 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

4 responses on “VBA – Outlook – Work With Search Folders

  1. Craig

    This was very helpful. I put macro buttons in my Quick Access Toolbar to easily navigate between folders and inboxes in different accounts in Outlook. Now I have a macro button that brings me to my “All Documents” search folder (which shows all sent and received emails for an account). Thank you!!!

  2. Marek

    Thanks a lot, really a lot for your advice and code. This is a function I have been looking for in vains for several weeks.

    It also opens door to many other folder and mail operations that are normally, i.e. without GetSearchFolder unavailable, while with GetSearchFolder you may set an object-type variable to the ofolder and use the folder (and mail stored in it) in various tasks.
    Best regards from a very happy computer user
    Marek