Sub LeseOutlookKontakte(ByVal Ordner As String)
        On Error Resume Next
 
        Dim app As New Microsoft.Office.Interop.Outlook.Application
        Dim ns As Microsoft.Office.Interop.Outlook.NameSpace
        Dim myContacts As Microsoft.Office.Interop.Outlook.MAPIFolder
        Dim myContact As Microsoft.Office.Interop.Outlook.ContactItem
 
        ' app = app.GetNamespace("MAPI")
        ns = app.GetNamespace("MAPI")
        myContacts = ns.GetDefaultFolder(OlDefaultFolders.olFolderContacts)
 
        For Each myContact In myContacts.Items
            Debug.Write(myContacts.Name & ": " & myContact.LastName)
        Next
    End Sub
 
    MsgBox(myContacts.Folders.Item(1).Folders.Item(1).Name)