Volet de navigation Outlook 2010 personnalisé

Question

Je souhaite créer un volet de navigation personnalisé pour Outlook. Ma configuration actuelle (voir image) fonctionne bien pour faire glisser et déposer des courriels individuels dans le dossier approprié. NB J'utilise Outlook 2010

Actuellement, j'ai un bouton dans la barre d'accès rapide qui exécute le OpenFolders vba sous, et les tuiles tout en (ou les ferme)

Cependant, je veux idéalement tous dans un une seule fenêtre.

Aussi je ne sais pas comment ouvrir avec tous les dossiers visibles - dans mon cas, cela signifie environ. 3 colonnes de noms de dossiers (cela ne change pas beaucoup, donc peut être codé en dur). Les noms seraient idéalement écrêtés pour réduire la largeur de l'écran. En fin de compte, ce simple «volet de navigation» aurait également un petit bouton au RHS de chaque nom de dossier, qui déplacerait automatiquement l'email dans le volet de lecture et sélectionnerait le prochain email (plutôt que de glisser et déposer).

Ceci est mon code simple actuel (NB GetFolderPath renvoie une référence au dossier correspondant du chemin en dessous de la boîte de réception)

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

Non, il n'y a pas de méthode pour ouvrir/fermer des hiérarchies de dossiers dans le volet de navigation. Vos seules options pertinentes sont de définir Explorer.CurrentFolder ou Folder.Display

Answer 2

Le modèle d'objet Outlook ne fournit rien pour la réduction des dossiers dans le volet de navigation. Pour développer un dossier, vous avez juste besoin d'en faire le dossier actuel dans la fenêtre de l'Explorateur (apportez-le à la vue). La classe CurrentFolder de la propriété Explorer permet de définir un objet Folder représentant le dossier actuel affiché dans l'explorateur.

Mais il n'y a pas de telles méthodes pour l'effondrement. Comme une solution de contournement, vous pouvez envisager de supprimer et d'ajouter des magasins à la volée. Dans ce cas, les dossiers sont affichés comme étant réduits.

Une autre possibilité consiste à utiliser UI Automation pour réduire l'arborescence de dossiers dans le volet de navigation.