Autor: Rainer Beckerbauer (Ramses)  --- Aus Excel VBA - Gruppe: Outlook & Excel

Outlook und Excel (5) Adressbuch und Kontakte

Autor: Rainer Beckerbauer (Ramses) - Erstellt: --      - Letzte Revision: --Gruppenthema: 6 Folgen 1 2 3 4 5 6 Sie sind in Folge:5
Listbox füllen mit Daten aus dem Outlook Adressbuch

In dieser Übung werden wir das Adressbuch von Outlook auslesen, und die wichtigsten Daten in einer Userform-Listbox darstellen.
Die Kontaktdaten können in der Listbox ausgewählt und weiter verwendet werden.

Für diese Übung benötigen Sie folgendes:
Eine leere Mappe
Eine Userform mit:
1 Commandbutton
1 Listbox

Wenn Sie die Userform erstellt haben, fügen Sie den folgenden Code in den Commandbutton ein.

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




Senden einer EXCEL Kontakt-Datenliste nach Outlook


Diese Daten können auch von Outlook direkt importiert werden, allerdings muss der Datenbereich
mit einem Namen benannt sein und sie müssen die Kontakfelder umständlich zuordnen.
Mit diesem Code können Sie das ganze auch von EXCEL aus steuern.
Dazu benötigen Sie eine Tabelle mit folgender Datenstruktur

 
  A B C D E F G
1 Name Vorname Strasse PLZ Ort Land E-Mail Addresse
2 Mustermann Hugo Musterstrasse 1000 Berlin D mh@berlin.de
3 Hinterhuber Max Oberkrainer-Weg 8000 München BY hm@bayern.de
4 Fischkopf Werner Thun-Strasse 2000 Hamburg D fw@hamburg.de
5 Kölsch Karl Jekkenweg 3000 Köln D kk@köln.de
6              
 


Dann können Sie mit dem nachfolgenden Code Ihre Daten aus EXCEL direkt nach Outlook senden:

Option Explicit

Sub Send_Contact_List()
    Dim qWks As Worksheet, i As Integer
    Dim MyOutApp As Object, MyOutCon As Object
    'Wo stehen die Kontaktdaten
    Set qWks = Worksheets("TabelleKontaktdaten")
    'Outlook Objekt erstellen
    Set MyOutApp = CreateObject("Outlook.Application")
    'Mit "With" wird auf das Tabellenobjekt referenziert
    With qWks
        'Zählschleife starten
        'Dazu wird der letzten Eintrag in Spalte A bestimmt
        'Der Adressenbereich beginn in Zeile 2
        'deshalb startet auch die Zählschleife dort
        For i = 2 To Range("A65536").End(xlUp).Row
            'Outlook Kontaktobject erstellen
            Set MyOutCon = MyOutApp.CreateItem(2)
            'Eine vollständige Liste der möglichen Felder
            'finden Sie in der Outlook-VBA-Hilfe
            With MyOutCon
                .LastName = Cells(i, 1).Value
                .FirstName = Cells(i, 1).Offset(0, 1).Value
                .BusinessAddressStreet = Cells(i, 1).Offset(0, 2).Value
                .BusinessAddressPostalCode = Cells(i, 1).Offset(0, 3).Value
                .BusinessAddressCity = Cells(i, 1).Offset(0, 4).Value
                .BusinessAddressCountry = Cells(i, 1).Offset(0, 5).Value
                .BusinessAddressState = Cells(i, 1).Offset(0, 6).Value
                .Email1Address = Cells(i, 1).Offset(0, 7).Value
                .Save
            End With
            'Object entfernen
            Set MyOutCon = Nothing
        Next i
    End With
    Set MyOutApp = Nothing
End Sub




Weitere Artikel der Gruppe: Outlook & Excel Aus Excel VBA
Nach oben