Customised Outlook 2010 Navigation pane

Question

I want to create a custom navigation pane for Outlook. My current setup (see image) works OK for dragging and dropping individual emails to the appropriate folder. NB I'm using Outlook 2010

Currently I have a button in the Quick Access Toolbar which runs the OpenFolders vba sub, and tiles them all out (or closes them)

However ideally I want them all in a single window.

Also I'm not sure how to open with all folders visible - in my case this means approx. 3 columns of folder names (this doesn't change much so could be hardcoded). Names would ideally be clipped to decrease screen width.

Ultimately this single 'navigation pane' would also have a little button at the RHS of each folder name, which would automatically move the email in the reading pane and select the next email (rather than dragging and dropping).

This is my current simple code (NB GetFolderPath returns a reference to the relevant folder from the path below the inbox)

Global myEmailRoot
Global lastOFTime

Sub OpenFolders()
    myEmailRoot = "[email protected]\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

No, there's no method to expand/collapse folder hierarchies in the Navigation Pane. Your only relevant options are to set Explorer.CurrentFolder or Folder.Display

Answer 2

The Outlook object model doesn't provide anything for collapsing folders on the navigation pane. To expand a folder you just needed to make it the current one in the Explorer window (bring it to the view). The CurrentFolder property Explorer class allows to set a Folder object that represents the current folder displayed in the explorer.

But there is no such methods for collapsing. As a workaround you may consider removing and adding stores on the fly. In that case folders are shown as collapsed.

Another possibility would be to use UI Automation to collapse the folder tree in the navigation pane.