Outlook mit geöffneten Konten starten.

Private Sub Application_MAPILogonComplete()
    strNameOfStore = "NAME_DEINES_ACCOUNTS"  
    Set fldrPosteingang = Session.Stores.item(strNameOfStore).GetDefaultFolder(olFolderInbox)
    ActiveExplorer.SelectFolder fldrPosteingang
End Sub

Private Sub Application_MAPILogonComplete()
    arrNameOfStores = Array("NAME DES ERSTEN ACCOUNTS","NAME DES ZWEITEN ACCOUNTS","NAME DES DRITTEN ACCOUNTS")  
    For i = 0 to UBound(arrNameOfStores)
      Set fldrPosteingang = Session.Stores.item(arrNameOfStores(i)).GetDefaultFolder(olFolderInbox)
      ActiveExplorer.SelectFolder fldrPosteingang
    Next
End Sub

Private Sub Application_MAPILogonComplete()
    arrNameOfStores = Array("NAME DES ERSTEN ACCOUNTS","NAME DES ZWEITEN ACCOUNTS","NAME DES DRITTEN ACCOUNTS")  
    For i = 0 to UBound(arrNameOfStores)
      Set fldrPosteingang = Session.Stores.item(arrNameOfStores(i)).GetDefaultFolder(olFolderInbox)
      OpenFolders fldrPosteingang
      ActiveExplorer.SelectFolder fldrPosteingang
    Next
End Sub

Sub OpenFolders(ByVal fldr As Folder)
    For Each f In fldr.Folders
        If f.Folders.count > 0 Then
            OpenFolders f
        Else
            ActiveExplorer.SelectFolder f
        End If
    Next
End Sub

Private Sub Application_MAPILogonComplete()
    For Each store In Application.Session.Stores
        If InStr(1, store.DisplayName, "@") > 0 Then  
            ActiveExplorer.SelectFolder store.GetDefaultFolder(olFolderInbox)
        End If
    Next
End Sub

Private Sub Application_MAPILogonComplete() 
    Dim hasUnread As Boolean
    arrNameOfStores = Array("Persönlicher Ordner", "user@domain.net")  
    For Each Store In arrNameOfStores
        Set fldrPosteingang = Session.Stores(Store).GetDefaultFolder(olFolderInbox)
        OpenFolders fldrPosteingang
    Next
End Sub

Sub OpenFolders(ByVal fldr As Folder)
    If fldr.UnReadItemCount > 0 Then
        ActiveExplorer.SelectFolder fldr
    End If
    For Each f In fldr.Folders
        OpenFolders f
    Next
End Sub

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim varEntryIDs, objItem As Object, i As Integer
    varEntryIDs = Split(EntryIDCollection, ",")  
    For i = 0 To UBound(varEntryIDs)
        Set objItem = Application.Session.GetItemFromID(varEntryIDs(i))
        OpenFolders objItem.Parent.Store.GetDefaultFolder(olFolderInbox)
    Next
End Sub

Sub OpenFolders(ByVal fldr As Folder)
    If fldr.UnReadItemCount > 0 Then
        ActiveExplorer.SelectFolder fldr
    End If
    For Each f In fldr.Folders
        OpenFolders f
    Next
End Sub

Private Sub Application_MAPILogonComplete() 
    arrNameOfStores = Array("NamePostfach1","NamePostfach2","NamePostfach3")   
    For i = 0 to UBound(arrNameOfStores) 
      Set fldrPosteingang = Session.Stores.item(arrNameOfStores(i)).GetDefaultFolder(olFolderInbox) 
      ActiveExplorer.SelectFolder fldrPosteingang 
    Next 
End Sub

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()
   
    Dim lngWait As Long
 
    On Error Resume Next
 
    lngWait = 5 ' 5 Sekunden warten  
    
    Call StartTimer(lngWait)
 
End Sub
 
Private Sub StartTimer(ByVal lngIntervall As Long)
    g_lngTimer = SetTimer(0&, 0&, lngIntervall * 1000, AddressOf Start_OpenFolders)
End Sub

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 Start_OpenFolders()
 
    On Error Resume Next
    
    Call KillTimer(0&, g_lngTimer)

    Dim arrNameOfStores As Variant
    Dim i, fldrPosteingang

    arrNameOfStores = Array("NamePostfach1", "NamePostfach2")  

    For i = 0 To UBound(arrNameOfStores)
      Set fldrPosteingang = Session.Stores.Item(arrNameOfStores(i)).GetDefaultFolder(olFolderInbox)
      OpenFolders fldrPosteingang
      ActiveExplorer.SelectFolder fldrPosteingang
    Next
End Sub

Sub OpenFolders(ByVal fldr As Folder)
    Dim f
    For Each f In fldr.Folders
        If f.Folders.Count > 0 Then
            OpenFolders f
        Else
            ActiveExplorer.SelectFolder f
        End If
    Next
End Sub

Sub OpenFolders(ByVal fldr As Folder)
    Dim f As Folder, arrExclude As Variant, jumpOver As Boolean
    arrExclude = Array("Ordner1", "Ordner2")  
    For Each f In fldr.Folders
        If f.Folders.Count > 0 Then
            jumpOver = False
            For Each exclude In arrExclude
                If exclude = f.Name Then
                    jumpOver = True
                    Exit For
                End If
            Next
            If Not jumpOver Then OpenFolders f
        Else
            ActiveExplorer.SelectFolder f
        End If
    Next
End Sub

Private Sub Application_MAPILogonComplete()
    Dim strNameOfStore As String, regex As Object, arrExclude As Variant
    strNameOfStore = "NAME_DEINES_ACCOUNTS"  
    arrExclude = Array("Ordner1", "Ordner2")  
    Set regex = CreateObject("vbscript.regexp")  
    regex.IgnoreCase = True
    regex.Pattern = "^" & Join(arrExclude, "|") & "$"  
    OpenFolders Session.Stores.Item(strNameOfStore).GetDefaultFolder(olFolderInbox), regex
    Set regex = Nothing
End Sub

Sub OpenFolders(ByVal fldr As Folder, ByVal regexExclude As Object)
    Dim f As Folder, arrExclude As Variant, jumpOver As Boolean
    For Each f In fldr.Folders
        If f.Folders.Count > 0 Then
            If Not regexExclude.Test(f.Name) Then OpenFolders f, regexExclude
        Else
            ActiveExplorer.SelectFolder f
        End If
    Next
End Sub

Private Sub Application_MAPILogonComplete()
    arrNameOfStores = Array("USER@DOMAIN.DE")  
    For i = 0 To UBound(arrNameOfStores)
      Set fldrPosteingang = Session.Stores.Item(arrNameOfStores(i)).GetDefaultFolder(olFolderInbox)
      OpenFolders fldrPosteingang
      ActiveExplorer.SelectFolder fldrPosteingang
    Next
End Sub

Sub OpenFolders(ByVal fldr As Folder)
    For Each F In fldr.Folders
        If F.Folders.Count > 0 Then
            OpenFolders F
        Else
            ActiveExplorer.SelectFolder F
        End If
    Next
End Sub

Private Sub Application_MAPILogonComplete()
    Dim f As Folder, i As Integer, acc As Store, s As Store, fldrPosteingang As Folder, arrNameOfStores As Variant
    arrNameOfStores = Array("user@domain.tld")  
    ' for each store in array  
    For i = 0 To UBound(arrNameOfStores)
        Set s = Nothing
        ' check if store with name exists  
        For Each acc In Application.Session.Stores
            If LCase(acc.DisplayName) = LCase(arrNameOfStores(i)) Then
                Set s = acc
                Exit For
            End If
        Next
        
        If Not s Is Nothing Then
            Set fldrPosteingang = s.GetDefaultFolder(olFolderInbox)
            ' open folders of inbox  
            OpenFolders fldrPosteingang
            ' open search folders  
            For Each f In s.GetSearchFolders
                If Left(f.Name, 6) <> "MS-OLK" Then  
                    ActiveExplorer.SelectFolder f
                    Exit For
                End If
            Next
            ' select top inbox at the end  
            ActiveExplorer.SelectFolder fldrPosteingang
        Else
            MsgBox "Das Konto mit dem Namen '" & arrNameOfStores(i) & "' wurde nicht gefunden", vbExclamation  
        End If
        
    Next
End Sub

Sub OpenFolders(ByVal fldr As Folder)
    Dim f As Folder
    For Each f In fldr.Folders
        If f.Folders.Count > 0 Then
            OpenFolders f
        Else
            ActiveExplorer.SelectFolder f
        End If
    Next
End Sub