Finding folders while excluding a folder

A few months ago, I obtained the code below here in the VBAExpress forum. The code is brilliant, but I would like to add one more thing to it if possible. On the network I have access to Public Folders (which I don't currently use). How can I get this code to exclude Public Folders in the search?

Thanks :)

Code:

---

Sub FindFolderByName()
Dim Name As String
Dim FoundFolder As Folder

Name = InputBox("Find Name:", "Search Folder")
If Len(Trim$(Name)) = 0 Then Exit Sub
Set FoundFolder = FindInFolders(Application.Session.Folders, Name)
If Not FoundFolder Is Nothing Then
'If MsgBox("Activate Folder: " & vbCrLf & FoundFolder.FolderPath, vbQuestion Or vbYesNo) = vbYes Then
Set Application.ActiveExplorer.CurrentFolder = FoundFolder
'End If
Else
MsgBox "Not Found", vbInformation
End If
End Sub


Function FindInFolders(TheFolders As Outlook.Folders, Name As String)
Dim SubFolder As Outlook.MAPIFolder

On Error Resume Next
Set FindInFolders = Nothing

For Each SubFolder In TheFolders
Debug.Print SubFolder.Name
If LCase(SubFolder.Name) Like "*" & LCase(Name) & "*" Then
If MsgBox("Activate Folder: " & vbCrLf & SubFolder.FolderPath, vbQuestion Or vbYesNo) = vbYes Then
Set FindInFolders = SubFolder
Exit For
Else
' If folder is rejected act as if it was never suggested.
GoTo nextFolder
End If
Else
nextFolder:
Set FindInFolders = FindInFolders(SubFolder.Folders, Name)
If Not FindInFolders Is Nothing Then Exit For
End If
Next
End Function

---

bump

bump

you'll need the Private/Public Folder Attribute
If the Found Folder has the wrong Attribute, GoTo the next one.

You can reference any folder in the tree.

Code:

---

Sub FindFolderByName()

    Dim Name As String
    Dim FoundFolder As folder
   
    Dim topFolder As folder
       
    Name = InputBox("Find Name:", "Search Folder")
   
    If Len(Trim$(Name)) = 0 Then Exit Sub
   
    ' All folders
    'topFolder = Session.folders
   
    ' or Mailbox associated with the default Inbox
    'topFolder = Session.GetDefaultFolder(olFolderInbox).Parent
   
    ' or default Inbox
    topFolder = Session.GetDefaultFolder(olFolderInbox)

    Set FoundFolder = FindInFolders(topFolder.folders, Name)
   
    If Not FoundFolder Is Nothing Then
        'If MsgBox("Activate Folder: " & vbCrLf & FoundFolder.FolderPath, vbQuestion Or vbYesNo) = vbYes Then
        Set Application.ActiveExplorer.CurrentFolder = FoundFolder
        'End If
    Else
        MsgBox "Not Found", vbInformation
    End If
   
End Sub

---