Search Outlook Folder recursively

Category:

Office/VBA

Type:

Snippets

Difficulty:

Intermediate

Author:

Brian

Version Compatibility: Visual Basic 6, Visual Basic 5

More information:

This snippet allows you to search for an Outlook folder within a parent folder. Sample Usage:

Dim oMAPI As Outlook.NameSpace
Dim oParentFolder As Outlook.MAPIFolder
Dim objFolder As Outlook.MAPIFolder
    
Set oMAPI = GetObject _
   ("", "Outlook.application").GetNamespace("MAPI")
Set oParentFolder = oMAPI.Folders("Public Folders")

Set objFolder = OutlookFolderNames _
  (oParentFolder, "anyfoldername")

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
' None

Code:

Public Function OutlookFolderNames(objFolder As Outlook.MAPIFolder, strFolderName As String) As Object
'*********************************************************
    On Error GoTo ErrorHandler
    Dim objOneSubFolder As Outlook.MAPIFolder
    If Not objFolder Is Nothing Then
        If LCase(strFolderName) = LCase(objFolder.Name) Then
            Set OutlookFolderNames = objFolder
        Else
            ' Check if folders collection is not empty
            If objFolder.Folders.Count > 0 And _
                   Not objFolder.Folders Is Nothing Then
                For Each oFolder In objFolder.Folders
                    Set objOneSubFolder = oFolder
                    ' only check mail item folder
                    If objOneSubFolder.DefaultItemType _
                         = olMailItem Then
                        If LCase(strFolderName) = _
                          LCase(objOneSubFolder.Name) Then
                            Set OutlookFolderNames = _
                                   objOneSubFolder
                            Exit For
                        Else
                            If objOneSubFolder.Folders.Count _
                                > 0 Then
                                Set OutlookFolderNames = _
                                  OutlookFolderNames _
                                (objOneSubFolder, strFolderName)
                            End If
                        End If
                    End If
                Next
            End If
        End If
    End If

Exit Function

ErrorHandler:
    Set OutlookFolderNames = Nothing
End Function