Vielen Dank für eure schnelle Hilfe. Allerdings sehe ich mich vor dem nächsten Problem - es wäre ja auch zu schön um wahr zu sein. Also:
Das möchte ich gerne einfügen - ich muss kurz noch mal einwerfen - ich wurschtel mich so durch in VBA leider immer noch -
Option Explicit
Sub ListBox_Fill_With_Outlook_Contacts()
Dim myOutlook As Object
Dim conId As Integer
Dim conFolder As Object
Dim conItem As Object
Dim Qe As Integer
Dim ErrMsg As String
Application.StatusBar = " . . . die Adressen werden aus Outlook eingelesen"
Set myOutlook = CreateObject("Outlook.Application")
Set conFolder = myOutlook.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
'hier macht er immer einen Fehler bei (olFolderContacts)
Me.ListBox1.ColumnCount = 7
'Hier weiss ich ja bereits das ich die aktuelle Arbeitsmappe angeben muss
Me.ListBox1.ColumnWidths = "70; 70; 28; 70; 28; 70; 70"
For conId = 1 To conFolder.Items.Count
Set conItem = conFolder.Items(conId)
With conItem
Me.ListBox1.AddItem " "
On Error GoTo conError
Me.ListBox1.List(conId - 1, 0) = .FirstName & " " & .LastName
Application.StatusBar = "Datensatz " & conId & " von " & conFolder.Items.Count & " wird gelesen: " & .FirstName
If .BusinessAddressPostOfficeBox = "" Then
UserForm1.ListBox1.List(conId - 1, 1) = .BusinessAddressStreet
Else
UserForm1.ListBox1.List(conId - 1, 1) = .BusinessAddressPostOfficeBox
End If
Me.ListBox1.List(conId - 1, 2) = .BusinessAddressPostalCode
Me.ListBox1.List(conId - 1, 3) = .BusinessAddressCity
Me.ListBox1.List(conId - 1, 4) = .CustomerID
Me.ListBox1.List(conId - 1, 5) = .AssistantName
Me.ListBox1.List(conId - 1, 6) = .MiddleName
errorStepin:
End With
Next conId
ErrorExit:
'Object Variablen leeren
Set conItem = Nothing
Set conFolder = Nothing
Set myOutlook = Nothing
Application.DisplayAlerts = True
Application.StatusBar = False
Exit Sub
conError:
Select Case Err
Case 438
Set conItem = conFolder.Items(conId)
ErrMsg = "Datensatz " & conId & " ist korrupt, oder untestützt die Abfrage nicht."
ErrMsg = ErrMsg & vbCrLf & "Datensatzkennung:"
ErrMsg = ErrMsg & vbCrLf & "Erstelldatum: " & conItem.CreationTime
ErrMsg = ErrMsg & vbCrLf & "ObjectID" & conItem.EntryID
ErrMsg = ErrMsg & vbCrLf
ErrMsg = ErrMsg & vbCrLf & "Löschen ? "
Qe = MsgBox(ErrMsg, vbYesNo + vbCritical + vbDefaultButton2, "Datenfehler")
If Qe = vbYes Then
conItem.Delete
MsgBox ("Datensatz " & conId & " wurde gelöscht")
Resume errorStepin
Else
MsgBox "Datenimport wegen Datenfehler bei Datensatz " & conId & " abgebrochen"
Resume ErrorExit
End If
Case Else
MsgBox Err & ": " & Err.Description
Resume ErrorExit
End Select
End Sub