outlook vba jump to actual folder from favorite - vba

Question

Is there a way to (in VBA)
(1) jump from a folder in the outlook favorites pane to the actual folder in the tree pane and
(2) is there a way to establish if the "selected" folder is in the tree or in the favorites pane?

Answer 1

I've been using this for #1 forever. Answering this question, I've solved it in part for #2.
The 2 macros find the folder of the currently selected email or finds a folder by name.
I've only updated the 1st macro for now.
Private m_Folder As Outlook.MAPIFolder
Private m_Find As String
Private m_Wildcard As Boolean
'Jumps to the folder based on currently selected email - works great from a search or search folder
'Offers to Jump to the folder (if it was also in the favorites view)
Public Sub GetItemsFolderPath()
Dim obj As Object
Dim F As Outlook.MAPIFolder
Dim Msg$
Set obj = Application.ActiveWindow
If TypeOf obj Is Outlook.Inspector Then
Set obj = obj.CurrentItem
Else
Set obj = obj.Selection(1)
End If
Set F = obj.Parent
Debug.Print F.FolderPath
Debug.Print Application.ActiveExplorer.NavigationPane.CurrentModule.NavigationModuleType
Debug.Print Application.ActiveExplorer.NavigationPane.CurrentModule
Msg = "The path is: " & F.FolderPath & vbCrLf
'ModuleValue : Folder = 6 / Mail = 1
Msg = Msg & "Switch to the folder?"
If MsgBox(Msg, vbYesNo) = vbYes Then
Set Application.ActiveExplorer.CurrentFolder = F
End If
' If the found folder is a favorite... offer option to jump out of Mail ( favorites view )
' Should be able to figure it out prompting user (me) but this works for now
If Application.ActiveExplorer.NavigationPane.CurrentModule.NavigationModuleType = 0 Then
Msg = "If your folder is in your favorites list, you can Jump from Favorites. Do so now ? "
If MsgBox(Msg, vbYesNo) = vbYes Then
'The below does this "Set Application.ActiveExplorer.NavigationPane.CurrentModule.NavigationModuleType = 6"
'Toggle Back
Set Application.ActiveExplorer.NavigationPane.CurrentModule = Application.ActiveExplorer.NavigationPane.Modules(6)
'Toggle Back
Set Application.ActiveExplorer.NavigationPane.CurrentModule = Application.ActiveExplorer.NavigationPane.Modules(1)
End If
End If
End Sub
'Find a folder by name - case sensitive
Public Sub FindFolder()
Dim Name$
Dim Folders As Outlook.Folders
Set m_Folder = Nothing
m_Find = ""
m_Wildcard = False
Name = InputBox("Find Name:", "Search Folder")
If Len(Trim$(Name)) = 0 Then Exit Sub
m_Find = Name
m_Find = LCase$(m_Find)
m_Find = Replace(m_Find, "%", "*")
m_Wildcard = (InStr(m_Find, "*"))
Set Folders = Application.Session.Folders
LoopFolders Folders
If Not m_Folder Is Nothing Then
If MsgBox("Activate Folder: " & vbCrLf & m_Folder.FolderPath, vbQuestion Or vbYesNo) = vbYes Then
Set Application.ActiveExplorer.CurrentFolder = m_Folder
End If
Else
MsgBox "Not Found", vbInformation
End If
End Sub
'used by the search to loop through
Private Sub LoopFolders(Folders As Outlook.Folders)
Dim F As Outlook.MAPIFolder
Dim Found As Boolean
For Each F In Folders
If m_Wildcard Then
Found = (LCase$(F.Name) Like m_Find)
Else
Found = (LCase$(F.Name) = m_Find)
End If
If Found Then
Set m_Folder = F
Exit For
Else
LoopFolders F.Folders
If Not m_Folder Is Nothing Then Exit For
End If
Next
End Sub