0

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?

Victor Onrust
  • 1
  • 4

1 Answers1

0

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
Admin OD46
  • 1