Outlook Kontaktdatenbank in Excel mit "Verbindung" einbinden

[Thomas_WP]

Hallo liebe Excel Experte,

ich habe jetzt länger im Netz gesucht aber nichts "Verständliches" zum Thema gefunden.

Ausgangslage:
1) Ich habe sämtliche Mitarbeiter in Outlook angelegt
2) Ich nutze eine Excel-Liste wo sämtliche Mitarbeiter aufgelistet sind und diesen Hardware sowie Software zuordne die sie verwenden.
 
Aufgabenstellung:
1)      Wenn neue Mitarbeiter eingestellt werden trage ich die in die Outlook Liste ein auf welche alle Zugriff haben. Ich möchte diese Datenbank aber mit meiner Excel-Datei verknüpfen, dass ich dort über „aktualisieren“ die neuen oder geänderten Mitarbeiter automatisch habe.

Wäre toll wenn ihr mir helfen könntet.

lg

Thomas

[Helvetier]

Hallo Thomas
Hier ein Makro, welches das "umgekehrte" macht: Nachführen der Outlookkontakte ab einer Excel-"Datenbank". Vielleicht kannst da etwas umbauen.
Gruss

Code:

'Example 3: This example exports data from an Excel Worksheet to the default Contacts folder (new contact items added with Items.Add Method), using Late Binding.
'http://www.globaliconnect.com/excel/index.php?option=com_content&view=article&id=167:import-contacts-from-excel-to-outlook-automate-in-vba&catid=79&Itemid=475
'Anpassungen durch XY
Sub ExcelWorksheetDataAddToOutlookContacts()
   'Automating Outlook from Excel: This example uses the Items.Add Method to export data from an Excel Worksheet to the default Contacts folder.
   'Automate Outlook from Excel, using Late Binding. You need not add a reference to the
   'Outlook library in Excel (your host application), in this case you will not be able to use the Outlook's predefined constants and will need to replace them by their numerical values in your code.
   'Ensure that the worksheet data to be posted to Outlook, starts from row number 2:
   'Ensure corresponding columns of data in the Worksheet, as they will be posted in the Outlook Contacts Folder:
   'Column B: First Name
   'Column C: Last Name
   'Column Mail: Email Address
   'Column D: Company Name
   'Column Handy: Mobile Telephone Number

   Dim oApplOutlook As Object
   Dim oNsOutlook As Object
   Dim oCFolder As Object
   Dim subFolder1 As Object
   Dim oDelFolder As Object
   Dim oCItem As Object
   Dim oDelItems As Object
   Dim lLastRow As Long, i As Long, n As Long, c As Long
   
   
   'prüfen, ob die Datenquelle geöffnet ist
   strFokus = "Mitgliederliste " & sngJahr & strErweiterung
   Datei_geöffnet_prüfen
   If bolDateiGeöffnet = True Then
       MsgBox "Eine Datei """ & strFokus & """ist geöffnet." & VBA.Chr(13) & VBA.Chr(10) & _
       "Schliesse bitte die Datei """ & strFokus & """ ." & VBA.Chr(13) & VBA.Chr(10) & _
       "Betätige noch einmal den """ & strCaption & """-Button."
       GoTo Endhandler
   End If
   
   'prüfen, ob die Datenquelle im Ordner "MITGLIEDERLISTE" vorhanden ist
   strPfad = VBA.Left(ThisWorkbook.Path, VBA.InStrRev(ThisWorkbook.Path, "\", -1) - 1) & "\" & VBA.UCase(VBA.Left(strFokus, VBA.InStr(strFokus, " ") - 1))
   strFile = strPfad & "\" & strFokus
   Quelle_vorhanden
   If bolQuelleExistiert = False Then
       MsgBox "Eine Datei """ & strFokus & """ im Verzeichnis " & VBA.Chr(13) & VBA.Chr(10) & _
       "" & strPfad & "" & VBA.Chr(13) & VBA.Chr(10) & _
       "gibt es nicht."
       GoTo Endhandler
   End If

   'öffnen der Datenquelle "Mitgliederliste [XXXX].xls"
   strFile = strPfad & "\" & strFokus
   Quelle_öffnen
   ActiveWindow.Visible = True
   
   On Error GoTo keinMerker
   Application.ScreenUpdating = False
   'determine last data row in the worksheet:
   lLastRow = Sheets("Adressenliste").Cells(Rows.Count, "A").End(xlUp).Row

   'Create a new instance of the Outlook application, if an existing Outlook object is not available.
   'Set the Application object as follows:
   On Error Resume Next
   Set oApplOutlook = GetObject(, "Outlook.Application")
   'if an instance of an existing Outlook object is not available, an error will occur (Err.Number = 0 means no error):
   If Err.Number <> 0 Then
       Set oApplOutlook = CreateObject("Outlook.Application")
   End If
   'disable error handling:
   On Error GoTo 0

   'use the GetNameSpace method to instantiate (ie. create an instance) a NameSpace object variable, to access existing Outlook items. Set the NameSpace object as follows:
   Set oNsOutlook = oApplOutlook.GetNamespace("MAPI")

   '----------------------------
   ''Empty the Deleted Items folder in Outlook so that when you quit the Outlook application you bypass the prompt: Are you sure you want to permanently delete all the items and subfolders in the "Deleted Items" folder?
   'set the default Deleted Items folder:
   'The numerical value of olFolderDeletedItems is 3.
   'The following code has replaced the Outlook's built-in constant olFolderDeletedItems by its numerical value 3.
   Set oDelFolder = oNsOutlook.GetDefaultFolder(10)        'findet den Ordner "Kontakte"
   Set subFolder1 = oDelFolder.Folders("Seniorenriege")    'finden im Ordner "Kontakte" den Unterordner "Seniorenriege"
   'set the items collection:
   Set oDelItems = subFolder1.Items
   'determine number of items in the collection:
   c = oDelItems.Count
   'start deleting from the last item:
   For n = c To 1 Step -1
       oDelItems(n).Delete
   Next n

   '----------------------------

   'set reference to the default Contact Items folder:
   'The numerical value of olFolderContacts is 10.
   'The following code has replaced the Outlook's built-in constant olFolderContacts by its numerical value 10.
   strKontakt = "Seniorenriege"
   Set oCFolder = oNsOutlook.GetDefaultFolder(10)
   Set subFolder1 = oCFolder.Folders(strKontakt)
   
   'post each row's data on a separate contact item form:
   For i = 4 To lLastRow
       If Sheets("Adressenliste").Cells(i, 1) <> "-" Then
           'die folgende Wenn-Prüfung ist anzuwenden,wenn Outlook auch von den Turnern ein Konto
           'einrichten soll, die keine Mail-Adresse haben.
           'If Sheets("Adressenliste").Cells(i, Range("Mail").Column) <> "" Then
               'Using the Items.Add Method to create a new Outlook contact item in the default Contacts folder.
               Set oCItem = subFolder1.Items.Add
               
               'display the new contact item form:
               'Anzeige nicht notwendig
               'oCItem.Display
               
               'set properties of the new contact item:
               With oCItem
                   .firstName = Sheets("Adressenliste").Cells(i, 3).Value
                   .lastName = Sheets("Adressenliste").Cells(i, 2).Value
                   .Email1Address = Sheets("Adressenliste").Cells(i, Range("Mail").Column).Value
                   '.Funktionär=Sheets("Adressenliste").Cells(i, Range("Funktionär").Column)
                   .HomeAddressStreet = Sheets("Adressenliste").Cells(i, Range("Strasse").Column).Value
                   .HomeAddressPostalCode = Sheets("Adressenliste").Cells(i, Range("Postleit").Column).Value
                   .HomeAddressCity = Sheets("Adressenliste").Cells(i, Range("Wohnort").Column).Value
                   .CompanyName = strKontakt '"Seniorenriege" 'subFolder1
                   .HomeTelephoneNumber = Sheets("Adressenliste").Cells(i, Range("Telefon").Column).Value
                   .MobileTelephoneNumber = Sheets("Adressenliste").Cells(i, Range("Handy").Column).Value
                   .Save
               End With
               'Stop
               'close the new contact item form after saving:
               'The numerical value of olSave is 0. The following code has replaced the Outlook's built-in constant olSave by its numerical value 0.
               'oCItem.Close 0
           'End If
       End If
   Next i
keinMerker:
   On Error GoTo 0
   oCItem.Close 0
   Workbooks(strFokus).Close savechanges:=False
   Application.ScreenUpdating = True
   
   
   'quit the Oulook application:
   oApplOutlook.Quit

   'clear the variables:
   Set oApplOutlook = Nothing
   Set oNsOutlook = Nothing
   Set oCFolder = Nothing
   Set oDelFolder = Nothing
   Set oCItem = Nothing
   Set oDelItems = Nothing
   MsgBox "Das Adressbuch von Outlook ist hiermit mit der Adressenliste der Seniorenriege synchronisiert."
Endhandler:
End Sub

[Thomas_WP]

Danke vielmals für die schnelle Antwort,

leider ist das nicht möglich da mehrere Personen in der Outlook Datenbank Informationen hinterlegen. Ich müsste den Export dann von dort in meine Excel Liste tätigen und um nicht immer mehrere Schritte zu tätigen möchte ich auch vermeiden immer ein neues Arbeitsblatt in meine Arbeitsmappe zu importieren und die Verweise neu zu setzen wäre eine Datenverknüpfung sehr hilfreich.

lg

thomas

[GMG-CC]

Es gibt Maschinen, die sehr leistungsfähig sind.
Dazu gehören auch Suchmaschinen.
Und ich hebe eben einmal die Begriffe excel zugriff outlook adressbuch eingegeben.
Reichen die 86.500 Ergebnisse?

[Thomas_WP]

Danke vielmals....

ich habe da länger gesucht und immer eine Lösung im VBA gefunden.... ich würde es aber gerne mit einer "verbindung" machen.
Siehe Screenshot....

[Helvetier]

Halle Thomas
Google nach "outlook adressbuch verknüpfen mit Excel" und Du wirst fündig
Gruss