自定义 Outlook 2010 导航窗格

Question

我想为 Outlook 创建一个自定义导航窗格。 我当前的设置（见图）可以将单个电子邮件拖放到适当的文件夹中。注意我使用的是 Outlook 2010

目前我在快速访问工具栏中有一个按钮，它运行 OpenFolders vba sub，并将它们全部平铺（或关闭它们）

但理想情况下，我希望它们都在一个窗口中。

此外，我不确定如何在所有文件夹可见的情况下打开 - 在我的情况下，这意味着大约。 3 列文件夹名称（这不会发生太大变化，因此可以硬编码）。 理想情况下，名称会被剪裁以减小屏幕宽度。

最终，这个单一的“导航窗格”还会在每个文件夹名称的 RHS 处有一个小按钮，它会自动在阅读窗格中移动电子邮件并选择下一封电子邮件（而不是拖放）。

这是我当前的简单代码（NB GetFolderPath 从收件箱下方的路径返回对相关文件夹的引用）

Global myEmailRoot
Global lastOFTime

Sub OpenFolders()
    myEmailRoot = "me@email.com\Inbox\"

    'Single Clicking the OpenFolders button will open the windows, or if already open then retile them in order
    'Double Clicking the OpenFolders button in the Quick Access Toolbar will close the windows

    If sortIfFolderWindowsExist Then
        If Timer() - lastOFTime < 5 Then
            closeFolderWindows
        End If
        Exit Sub
    End If

    lastOFTime = Timer()

    Dim oFolder As Outlook.Folder

    Set oFolder = GetFolderPath("CCG")
    oFolder.Display
    resizeWin (0)

    Set oFolder = GetFolderPath("Mental Health")
    oFolder.Display
    resizeWin (1)

    Set oFolder = GetFolderPath("Personal")
    oFolder.Display
    resizeWin (2)

    Set oFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    oFolder.Display
    resizeWin (3)

End Sub

Sub resizeWin(col)
    Outlook.Application.ActiveExplorer.Left = col * 150
    Outlook.Application.ActiveExplorer.Top = 0
    Outlook.Application.ActiveExplorer.Width = 1920 - (col * 150)
    Outlook.Application.ActiveExplorer.Height = 1024
End Sub

Function sortIfFolderWindowsExist()
    ' resort windows (if they exist) so layering is correct
    i = 1
    curColPix = 0
    While i > 0
        For i = Explorers.Count To 0 Step -1
            If Explorers(i).Left = curColPix Then
                Explorers(i).Activate
                Exit For
            End If
        Next
        curColPix = curColPix + 150
        If curColPix > 450 Then
            sortIfFolderWindowsExist = True
            Exit Function
        End If
    Wend
End Function

Function closeFolderWindows()
    ' resort windows (if they exist) so layering is correct
    i = 1
    curColPix = 450
    maxWin = 0
    minWin = 9999
    While i > 0
        For i = Explorers.Count To 1 Step -1
            If Explorers(i).Left = curColPix Then
                If i > maxWin Then maxWin = i
                If i < minWin Then minWin = i
                correctWins = correctWins + 1
                Explorers(i).Activate
                If maxWin - minWin = 3 Then
                    For j = 1 To 4
                        Explorers(minWin).Close
                    Next
                    Exit Function
                End If
                Exit For
            End If
        Next
        curColPix = curColPix - 150
    Wend
End Function

Function GetFolderPath(ByVal folderPath As String) As Outlook.Folder
    Dim oFolder As Outlook.Folder
    Dim FoldersArray As Variant
    Dim i As Integer

    On Error GoTo GetFolderPath_Error
    If Left(folderPath, 2) = "\\" Then
        folderPath = Right(folderPath, Len(folderPath) - 2)
    Else
        folderPath = myEmailRoot & folderPath
    End If

    'Convert folderpath to array
    FoldersArray = Split(folderPath, "\")
    Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
    If Not oFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)
            Dim SubFolders As Outlook.Folders
            Set SubFolders = oFolder.Folders
            Set oFolder = SubFolders.Item(FoldersArray(i))
            If oFolder Is Nothing Then
                Set GetFolderPath = Nothing
            End If
        Next
    End If
    'Return the oFolder
    Set GetFolderPath = oFolder
    Exit Function

GetFolderPath_Error:
    Set GetFolderPath = Nothing
    Exit Function
End Function

Answer 1

不，没有在导航窗格中展开/折叠文件夹层次结构的方法。您唯一相关的选项是设置 Explorer.CurrentFolder 或 Folder.Display

Answer 2

Outlook 对象模型不提供任何用于折叠导航窗格上的文件夹。要展开一个文件夹，您只需将其设为资源管理器窗口中的当前文件夹（将其带到视图中）。 CurrentFolder 属性 Explorer 类允许设置一个 Folder 对象，该对象表示在资源管理器中显示的当前文件夹。

但是没有这样的折叠方法。作为一种解决方法，您可以考虑即时删除和添加商店。在这种情况下，文件夹显示为折叠状态。

另一种可能性是使用UI Automation 折叠导航窗格中的文件夹树。