Private Sub CommandButton7_Click()
Dim objOutlook As Object
Dim objAddressList As Object
Dim objAddressEntry As Object
Dim intCounter As Integer
Dim bln As Boolean
Application.ScreenUpdating = False
bln = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Set objOutlook = CreateObject("Outlook.Application")
Set objAddressList = _
objOutlook.Session.AddressLists("Contacts")
intCounter = 10
For Each objAddressEntry In objAddressList.AddressEntries
intCounter = intCounter + 1
If intCounter Mod 10 = 0 Then
Application.StatusBar = _
"Lese Adresse Nr. " & intCounter & " ein..."
End If
Cells(intCounter, 1) = objAddressEntry.Name
Set objAddressList = Nothing
Set objAddressEntry = Nothing
Set objOutlook = Nothing
Application.DisplayStatusBar = bln
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub
Ich würde gerne neben dem Namen noch die restlichen Daten aus den Kontakten importieren. Kennt jemand die entsprechenden Objektnamen im Outlook? (.Adresse, .Vorname, .Firma,.. funkt nicht!)
bitte helfen - danke
Günther