Bitte Tipp für VBA-Script - Outlook 2007 IMAP-Ordner aufklappen

Private Sub Application_Startup()
    Dim objFolder As Outlook.folder
    Dim folder As Outlook.folder
    Dim folder2 As Outlook.folder
    Dim strStartFolder As String
    Dim lngFolder As Long
    Dim x As Integer
    Dim bad As String
   
    'namen des Ordners, der nicht expandiert werden soll  
    bad = "Archivordner IMAP"  
    'max ermitteln  
    x = Outlook.Session.Folders.Count
    ' Auch bei Fehler weitermachen '  
    On Error Resume Next
    ' Startordner festlegen (z. B. "Kontakte", "Posteingang", "Aufgaben" etc.)  
    strStartFolder = "Outlook-Heute"  
    ' Alle Konten-Ordner aufklappen'  
    For i = 0 To x
        'überprüfen ob es der bad ordner ist, nur weiter,  
        'wenn ers nicht ist  
        If (Outlook.Session.Folders.Item(i) <> bad) Then
            'Posteingang markieren um Konto order aufzuklappen  
            Call Outlook.ActiveExplorer.SelectFolder( _
                            Outlook.Session.Folders(i).Folders("Posteingang"))  
            subs = Outlook.Session.Folders(i).Folders( _
                                                  "Posteingang").Folders.Count  
            If subs > 0 Then
                'Alle unterordner auch nochmal checken  
                For Each folder In Outlook.Session.Folders(i).Folders( _
                                                        "Posteingang").Folders  
                    'wenn größer ist, alle unterordner auch nochmal markieren  
                    If folder.Folders.Count > 0 Then
                        'Alle Elemente ermitteln und markieren um vollständig  
                        'aufzuklappen  
                        'Alle elemente werden markiert, um "id lücken" zu  
                        'überbrücken und einen crash zu vermeiden  
                        For Each folder2 In folder.Folders
                            Call Outlook.ActiveExplorer.SelectFolder(folder2)
                        Next folder2
                    End If
                Next folder
            End If
        End If
    Next i
  'zu guter letz zu outlook heute wechseln (nutze den persönlichen ordner  
    'dafür, der einfach "Heute" heisst, da er sich nicht löschen läßt.  
    Call Outlook.ActiveExplorer.SelectFolder(Outlook.Session.Folders("Heute"))  
End Sub