Outlook vba 从收藏夹跳转到实际文件夹

Question

有没有办法（在 VBA 中）

(1) 从 Outlook 收藏夹窗格中的文件夹跳转到树形窗格中的实际文件夹并

(2) 有没有办法确定“选定”文件夹是在树中还是在收藏夹窗格中？

Answer 1

我一直在使用它作为#1。回答这个问题，我已经部分解决了#2。

这 2 个宏查找当前所选电子邮件的文件夹或按名称查找文件夹。 我现在只更新了第一个宏。

Private m_Folder 作为 Outlook.MAPIFolder 私有 m_Find 作为字符串 私有 m_Wildcard 作为布尔值

'根据当前选择的电子邮件跳转到文件夹 - 在搜索或搜索文件夹中效果很好 '提供跳转到文件夹（如果它也在收藏夹视图中）

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