If they are on the same level as Inbox then replace the three macros below in the userform code and it will display all the folders (and subfolders) on the same level as inbox by initial letter:
Code:
Private Sub lstFolders_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim olFldr As Folder
Dim vFolder As Variant
Dim i As Integer
Set olFldr = Session.GetDefaultFolder(olFolderInbox).Parent
vFolder = Split(lstFolders.Text, "\")
For i = 0 To UBound(vFolder)
Set olFldr = olFldr.folders(vFolder(i))
Next i
Hide
olFldr.Display
lbl_Exit:
Set olFldr = Nothing
Unload Me
Exit Sub
End Sub
Private Sub CommandOK_Click()
Dim olFldr As Folder
Dim vFolder As Variant
Dim i As Integer
If lstFolders.ListIndex > -1 Then
Set olFldr = Session.GetDefaultFolder(olFolderInbox).Parent
vFolder = Split(lstFolders.Text, "\")
For i = 0 To UBound(vFolder)
Set olFldr = olFldr.folders(vFolder(i))
Next i
Hide
olFldr.Display
Else
Beep
MsgBox "Nothing selected"
End If
lbl_Exit:
Set olFldr = Nothing
Unload Me
Exit Sub
End Sub
Private Sub ResetList(X As String)
Dim cFolders As Collection
Dim olfolder As Outlook.Folder
Dim SubFolder As Outlook.Folder
Dim olNS As Outlook.NameSpace
Dim strPath As String
Dim sSubPath As String
Dim sStore As String
lstFolders.Clear
Set cFolders = New Collection
Set olNS = GetNamespace("MAPI")
cFolders.Add olNS.GetDefaultFolder(olFolderInbox).Parent
Do While cFolders.Count > 0
Set olfolder = cFolders(1)
cFolders.Remove 1
sStore = olfolder.Store
sSubPath = Replace(olfolder.FolderPath, "\\" & sStore & "\", strPath)
ProcessFolder olfolder, sSubPath, X
If olfolder.folders.Count > 0 Then
For Each SubFolder In olfolder.folders
cFolders.Add SubFolder
Next SubFolder
End If
Loop
lbl_Exit:
Set olfolder = Nothing
Set SubFolder = Nothing
Set cFolders = Nothing
Exit Sub
End Sub