Question

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

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

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

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

最终这个单一的导航窗格＆＃39;在每个文件夹名称的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折叠导航窗格中的文件夹树。

自定义Outlook 2010导航窗格

2 个答案: