Dim objNS As Outlook.NameSpace
        Dim objMF As Outlook.MAPIFolder
        Dim objAL As Outlook.Folders
        Dim objIt As Outlook.Items
        Dim zaehler As Integer
 
        objOutlook = GetObject(, "Outlook.Application")
 
        objNS = objOutlook.GetNamespace("MAPI")
 
        objAL = objNS.Folders
        Call showfolders(objAL)
 
        objIt = Nothing
        objAL = Nothing
        objMF = Nothing
        objNS = Nothing
        objOutlook = Nothing
 
---------------------------
 
    Private Function showfolders(ByRef objAL As Outlook.Folders)
        Dim zaehler As Integer
        Dim objFd As Outlook.Folders
 
        For zaehler = 1 To objAL.Count
            If objAL.Item(zaehler).DefaultItemType = _
              Outlook.OlItemType.olContactItem Then
                MsgBox(objAL.Item(zaehler).Name)
 
            End If
 
            If objAL.Item(zaehler).Folders.Count > 0 Then
                Call showfolders(objAL.Item(zaehler).Folders)
            End If
        Next zaehler
    End Function