IMAP - Ordner automatisch aufklappen (ab 2007)

IMAP-Ordner werden beim Öffnen von Outlook® immer geschlossen dargestellt. Mit dem folgenden Skript werden alle Ordner mit Namen Posteingang automatisch geöffnet und zuletzt ein zuvor definierter Startordner ausgewählt.

Hinweis: Outlook® klappt den Standardordner immer auf, was sich auch durch Programmcode nicht so ohne weiteres verhindern lässt.

Zur Verwendung dieses Beispiels beachten Sie bitte die wichtigen Hinweise, sowie den Workshop VBA in Outlook® verwenden.

Ab Outlook® 2007

Diesen Codeteil bitte in das Modul DieseOutlookSitzung kopieren:

Option Explicit
 
Private Declare Function SetTimer Lib "user32.dll" ( _
    ByVal hwnd As Long, _
    ByVal nIDEvent As Long, _
    ByVal uElapse As Long, _
    ByVal lpTimerFunc As Long) As Long
 
Private Sub Application_Startup()
 
    '---------------------------------------------------------------------
    ' In manchen Fällen funktioniert der Programmcode nicht, wenn er sofort
    ' beim Start von Outlook ausgeführt wird. Daher wird der Code über einen
    ' Windows-Timer aufgerufen. Legen Sie in der Variablen "lngWait" die
    ' Anzahl Sekunden fest, nach der die Funktion zum Öffnen der Ordner
    ' aufgerufen werden soll.
    '---------------------------------------------------------------------
    
    Dim lngWait As Long
 
    On Error Resume Next
 
    lngWait = 5 ' 5 Sekunden nach Outlook-Start noch warten
    
    Call StartTimer(lngWait)
 
End Sub
 
Private Sub StartTimer(ByVal lngIntervall As Long)
    g_lngTimer = SetTimer(0&, 0&, lngIntervall * 1000, AddressOf OpenFolders)
End Sub

Den folgenden Codeteil bitte in ein neues Modul kopieren (Einfügen -> Modul im VBA-Editor):

Option Explicit
 
Public g_lngTimer As Long
 
Private Declare Function KillTimer Lib "user32.dll" ( _
    ByVal hwnd As Long, _
    ByVal nIDEvent As Long) As Long
 
Public Sub OpenFolders()
 
    '=====================================================================
    ' Öffnet nach einer eingestellten Zeit ab Programmstart alle Postein-
    ' gangsordner und wählt dann einen festgelegten Startordner aus.
    ' (c) Peter Marchert - http://www.outlook-stuff.com
    ' 2008-11-21 Version 1.0.0
    ' 2009-07-19 Version 1.1.0
    ' 2010-07-11 Version 1.2.0
    ' 2010-10-13 Version 1.3.0
    '=====================================================================

    Dim colStores As Outlook.Stores
    Dim objStore As Outlook.Store
    Dim objInbox As Outlook.Folder
    Dim objFolder As Outlook.Folder
    Dim objSearchFolders As Outlook.Folders
    Dim objSearchFolder As Outlook.Folder
 
    Dim strStartFolder As String            ' Ordner bei Programmstart
    Dim blnSearchFolders As Boolean
 
    On Error Resume Next
 
    '---------------------------------------------------------------------
    ' Timer wieder löschen, damit die Prozedur nicht ständig aufgerufen wird
    '---------------------------------------------------------------------
    Call KillTimer(0&, g_lngTimer)
 
    '---------------------------------------------------------------------
    ' Startordner festlegen (z. B. "Kontakte", "Posteingang", "Aufgaben" etc.)
    ' (Darf kein Unterordner sein)
    '---------------------------------------------------------------------
    strStartFolder = "Outlook-Heute"
 
    '---------------------------------------------------------------------
    ' Suchordner aufklappen (True = aufklappen)?
    '---------------------------------------------------------------------
    blnSearchFolders = False
 
    '---------------------------------------------------------------------
    ' Referenz auf alle Speicher setzen
    '---------------------------------------------------------------------
    Set colStores = Outlook.Session.Stores
 
    '---------------------------------------------------------------------
    ' Alle Speicher bearbeiten
    '---------------------------------------------------------------------    
    For Each objStore In colStores
 
        '-----------------------------------------------------------------
        ' Posteingangs-Ordner referenzieren
        '-----------------------------------------------------------------
        Set objInbox = objStore.GetRootFolder.Folders("Posteingang")
 
        '-----------------------------------------------------------------
        ' Posteingangs-Ordner aufklappen?
        ' Wenn Sie das Aufklappen für bestimmte PST-Dateien verhindern 
        ' möchten, schreiben Sie die Namen der Dateien in die erste Case-
        ' Anweisung durch Kommas getrennt.
        '-----------------------------------------------------------------
        Select Case objInbox.Parent.Name
            Case "Archiv 2008", "Archiv 2009"
                ' Nicht aufklappen
            Case Else
                Call Outlook.ActiveExplorer.SelectFolder(objInbox)
                DoEvents
        End Select
 
        '-----------------------------------------------------------------
        ' Suchordner auch aufklappen?
        '-----------------------------------------------------------------
        If blnSearchFolders Then
            Set objSearchFolders = objStore.GetSearchFolders
            For Each objSearchFolder In objSearchFolders
                Call Outlook.ActiveExplorer.SelectFolder(objSearchFolder)
                DoEvents
            Next
        End If
 
    Next
 
    '---------------------------------------------------------------------
    ' Ordner für Programmstart festlegen
    '---------------------------------------------------------------------
    If strStartFolder = "Outlook-Heute" Then
 
        Set objFolder = Outlook.Session.GetDefaultFolder(olFolderInbox).Parent
 
    Else
 
        Set objFolder = Outlook.Session.GetDefaultFolder(olFolderInbox)
        Set objFolder = objFolder.Parent.Folders(strStartFolder)
 
        '-----------------------------------------------------------------
        ' Wenn Sie einen anderen, als den Standardposteingang öffnen möchten,
        ' kommentieren Sie die nachfolgende Zeile aus. Die Zahl 1 müssen
        ' Sie gegebenenfalls noch anpassen (2, 3, 4 etc).
        '-----------------------------------------------------------------
        'Set objFolder = Outlook.Session.Folders(1).Folders("Posteingang")

        '-----------------------------------------------------------------
        ' Wenn Sie einen Unterordner aufklappen möchten, kommentieren Sie 
        ' die nachfolgende Zeile aus und passen gegebenenfalls die Zahl 1
        ' und den Ordnernamen an.
        '-----------------------------------------------------------------
        'Set objFolder = Outlook.Session.Folders(1).Folders("Posteingang").Folders("Privat")

    End If
 
    '---------------------------------------------------------------------
    ' Ordner bei Programmstart anwählen
    '---------------------------------------------------------------------
    Call Outlook.ActiveExplorer.SelectFolder(objFolder)
 
    '---------------------------------------------------------------------
    ' Referenzen löschen
    '---------------------------------------------------------------------
    Set colStores = Nothing
    Set objStore = Nothing
    Set objInbox = Nothing
    Set objFolder = Nothing
    Set objSearchFolders = Nothing
    Set objSearchFolder = Nothing
 
End Sub