Online-Excel "Outlook und Excel (5)"

Private Sub CommandButton1_Click()
'(C) by Ramses
'Verweis auf die Outlook Library muss gesetzt sein
'Variablen Deklaration
Dim MyOutId As Integer
Dim MyOutFolder As Object
Dim MyOutApp As Object
Dim MyConItem As Object
Dim Qe As Integer
Dim ErrMsg As String
'Bildschirmaktualisierung ausschalten
'Application.DisplayAlerts = False
'... und Statusbar-Info ausgeben
Application.StatusBar = " die Adressen werden aus Outlook geholt " _
& " - das kann einen Moment dauern."
'Object Deklaration
Set MyOutApp = CreateObject("Outlook.Application")
'Zugriff auf die MAPI Schnittstelle
Set MyOutFolder = MyOutApp.GetNamespace("MAPI").GetDefaultFolder(10)
'Zuweisen der Anzahl Spalten in der Listbox
Me.ListBox1.ColumnCount = 7
'Zuweisen der Spaltenbreite in Pt
'1 cm ~ 28,3 Pt
Me.ListBox1.ColumnWidths = "70; 70; 28; 70; 28; 70; 70"
'Einlesen der Daten
For MyOutId = 1 To MyOutFolder.Items.Count
'Zuweisen des Object für jeden Contact
Set MyConItem = MyOutFolder.Items(MyOutId)
'Einlesen des Contacts beginnen
With MyConItem
'Neuen Eintrag in Listbox einfügen
Me.ListBox1.AddItem " "
'ListIndex - 1 um auf das vorher erzeugte Item zuzugreifen
On Error GoTo conError
Me.ListBox1.List(MyOutId - 1, 0) = .FirstName & " " & .LastName
'Statusbar Information anzeigen
'um den Benutzer den Fortschritt anzuzeigen
Application.StatusBar = "Datensatz " & MyOutId & " von " & MyOutFolder.Items.Count & _
" wird gelesen: " & .FirstName
If .BusinessAddressPostOfficeBox = "" Then
Me.ListBox1.List(MyOutId - 1, 1) = .BusinessAddressStreet
Else
Me.ListBox1.List(MyOutId - 1, 1) = .BusinessAddressPostOfficeBox
End If
Me.ListBox1.List(MyOutId - 1, 2) = .BusinessAddressPostalCode
Me.ListBox1.List(MyOutId - 1, 3) = .BusinessAddressCity
Me.ListBox1.List(MyOutId - 1, 4) = .CustomerID
Me.ListBox1.List(MyOutId - 1, 5) = .AssistantName
Me.ListBox1.List(MyOutId - 1, 6) = .MiddleName
ErrorStepin:
End With
Next MyOutId
ErrorExit:
'Object Variablen leeren
Set MyConItem = Nothing
Set MyOutFolder = Nothing
Set MyOutApp = Nothing
'Bildschirm einschalten
Application.DisplayAlerts = True
'Statusbar zurücksetzen
Application.StatusBar = False
Exit Sub
conError:
Select Case Err
Case 438
'Es kann sein, dass ein Datensatz korrupt ist, aber in Outlook korrekt angezeigt  _
wird
'Allerdings können diese Datensätze nicht mit externen Geräte synchronisiert werden
Set MyConItem = MyOutFolder.Items(MyOutId)
ErrMsg = "Datensatz " & MyOutId & " ist korrupt, oder unterstützt die Abfrage nicht. _
ErrMsg = ErrMsg & vbCrLf & "Datensatzkennung:"
ErrMsg = ErrMsg & vbCrLf & "Erstelldatum: " & MyConItem.CreationTime
ErrMsg = ErrMsg & vbCrLf & "ObjectID" & MyConItem.EntryID
ErrMsg = ErrMsg & vbCrLf
ErrMsg = ErrMsg & vbCrLf & "Löschen ? "
Qe = MsgBox(ErrMsg, vbYesNo + vbCritical + vbDefaultButton2, "Datenfehler")
If Qe = vbYes Then
MyConItem.Delete
MsgBox ("Datensatz " & MyOutId & " wurde gelöscht")
'Listenzählung korrigieren
MyOutId = MyOutId + 1
Me.ListBox1.ListIndex(MyOutId).Delete
Resume ErrorStepin
Else
MsgBox "Datenimport wegen Datenfehler bei Datensatz " & MyOutId & " abgebrochen" _
Resume ErrorExit
End If
Case Else
MsgBox Err & ": " & Err.Description
Resume ErrorExit
End Select
End Sub