outlook aufklappen Versuch3

Sub ExpandAllFolders()
    Dim objOlApp As Outlook.Application

    Set objOlApp = GetObject(, "Outlook.Application")
    On Error Resume Next

    If Err.Number = 429 Then
       'MsgBox ("Error 429 appeared")
       Set objOlApp = CreateObject("Outlook.Application")
    End If
   On Error GoTo 0

    'MsgBox ("continuing usual stuff")
    Dim objFolder As Outlook.Folder
    Set objFolder = Set objFolder = Session.GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders("TG Kontakte").Folders("Restaurant")

    Set objFolder = Session.GetDefaultFolder(olFolderInbox)
    Set objOlApp.ActiveExplorer.CurrentFolder = objFolder

    Set objFolder = Nothing
    Set objOlApp = Nothing

End Sub