You could confirm the folder is the one you want before leaving the search.
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
Not a list to choose from, this offers up one folder at a time to confirm.
When crossposting try to leave a link so everyone knows the status.