Question

有没有办法（在VBA中）

（1）从Outlook收藏夹窗格中的文件夹跳转到树窗格中的实际文件夹

（2）有没有办法确定“selected”文件夹是在树中还是在收藏夹窗格中？

Answer 1

1）通过所有公共文件夹递归搜索文件夹名称。

2）ActiveExplorer.CurrentFolder.FolderPath获取路径。使用InStr查找＆＃34;收藏夹＆＃34;或＆＃34;所有公共文件夹＆＃34;。

Option Explicit

Private Sub FavoritesOrTree()

Dim startFolder As Folder
Dim parentFolder As Folder
Dim path As String

Set startFolder = ActiveExplorer.CurrentFolder
Debug.Print startFolder

path = startFolder.FolderPath
Debug.Print "Path: " & path

If InStr(path, "Favorites") Then
    Debug.Print "Favorites"

ElseIf InStr(path, "All Public Folders") Then
    Debug.Print "Tree"

Else
    Debug.Print "Not in a public folder?"

End If

End Sub

Answer 2

我一直在第一时间使用它。回答这个问题，我已经部分解决了＃2的问题。

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

将m_Folder作为Outlook.MAPIFolder 私人m_Find As String 私有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

outlook vba跳转到收藏夹的实际文件夹

2 个答案: