Outlook
18.05.2004 14:40:45
Kerstin
ich habe ein Makro gefunden, dass die Daten aus den Kontakte im Outlook ausliesst. Allerdings ist es mal wieder nicht so einfach wie gedacht. Die Kollegen haben sich teilweise Unterordner angelegt.
Wie kann ich das Makro nun verändern, sodass automatisch der Ordner Kontakte mit all seinen Unterordnern ausgelesen wird.
Hier das gefundene Makro:
Sub OutlookContact()
Dim objOLApp As Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim objContItem As Object
Dim i As Integer
Set objOLApp = CreateObject("Outlook.Application")
Set objNameSpace = GetNamespace("MAPI")
i = 1
Worksheets.Add
For Each objContItem In objNameSpace. _
GetDefaultFolder(olFolderContacts). _
Items
If objContItem.Class = olContact Then
' Vorname und Nachname
Cells(i, 1) = objContItem.FirstName & " " & _
objContItem.LastName
' E-Mail-Adresse 1
Cells(i, 2) = objContItem.Email1Address
' Geschäftsadresse
Cells(i, 3) = objContItem.BusinessAddress
' Telefonnumer Geschäft
Cells(i, 4) = objContItem.BusinessTelephoneNumber
' Telefonnummer privat
Cells(i, 5) = objContItem.HomeTelephoneNumber
' Ort privat
Cells(i, 6) = objContItem.HomeAddressCity
' Land privat
Cells(i, 7) = objContItem.HomeAddressCountry
Else
Cells(i, 1) = "Verteilerliste: " & objContItem.DLName
Cells(i, 1).Interior.ColorIndex = 15
End If
i = i + 1
Next objContItem
' Spaltenbreite automatisch anpassen
Columns("A:G").AutoFit
Set objContItem = Nothing
Set objNameSpace = Nothing
End Sub
Vielen Dank.
Gruss Kerstin