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")

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