Outlook: Ganze Ordnerstruktur aufklappen (Makro)

Haben Sie in Outlook eine umfangreiche Ordnerstruktur, welche Sie gerne immer geöffnet haben? Aber diese klappt gelegentlich zu uns Sie müssen von Hand alles wieder aufklappen?

Problem

Leider kennt Outlook keine Möglichkeit, mit einem Klick alle Ordner auf- oder zuzuklappen.
Das Kontextmenü in einem Windows-Ordner kennt immerhin die beiden Befehle "Reduzieren" und "Erweitern"; Outlook kennt dies nicht.

Lösung

Das folgende Makro dient dazu, den aktuellen Ordner aufzuklappen.

Kopieren Sie sich den folgenden Code, fügen ihn in ein neues Modul ein und fügen als Beispiel in der Menüleiste für den Schnellzugriff ein Icon hinzu, welches auf das Makro "pExpandFolder" zeigt.

Da das Aufklappen sämtlicher Ordner zum Teil sehr lange gehen kann, und man diese Arbeit auch nicht ausblenden kann (wie in Excel mit Application.ScreenUpdating = False), habe ich mich entschieden, dass immer nur der gerade markierte Ordner aufgeklappt wird.

Code (erste einfache Version)

Sub ExpandFolder()
On Error Resume Next

Dim Ns As Outlook.NameSpace
Dim Folders As Outlook.Folders
Dim CurrF As Outlook.MAPIFolder
Dim F As Outlook.MAPIFolder
Dim ExpandDefaultStoreOnly As Boolean

 

ExpandDefaultStoreOnly = True

Set Ns = Application.GetNamespace("Mapi")
Set CurrF = Application.ActiveExplorer.CurrentFolder
Set Folders = CurrF.Folders
pLoopFolders Folders, True

DoEvents
Set Application.ActiveExplorer.CurrentFolder = CurrF

End Sub

 

Private Sub pLoopFolders(Folders As Outlook.Folders, ByVal vRecursive As Boolean)
Dim objFolder As Outlook.MAPIFolder

 

For Each objFolder In Folders
  Set Application.ActiveExplorer.CurrentFolder = objFolder
  DoEvents

  If vRecursive = True Then
    If objFolder.Folders.Count Then
      pLoopFolders objFolder.Folders, vRecursive
    End If
  End If
Next
End Sub

MCTMOSM MOS2013small