Office: (Office 2016) Abteilung aus Outlook-Kontakte

Toulousi · 23. Oktober 2020

Hallo zusammen,

ich nutze die Kontakte-Datenbank von Access 365.

Ich hätte aber gerne zusätzlich aus den Outlook-Kontakten die Abteilung ausgelesen.

Kann mir jemand helfen, wie ich das hinbekomme.

Danke.

:)

knobbi38 · 25. Oktober 2020

Hallo,

wie greifst du denn bis jetzt auf die Felder zu?

Ulrich

Toulousi · 25. Oktober 2020

Wie gesagt, ich nutze die Vorlage Kontakte von Microsoft. Da geht das über das eingebettete Makro "HinzufügenKontaktAusOutlook".

Da zieht er alle allgemeinen Daten aber nicht die aus den Details.

fredfred · 25. Oktober 2020

mit Makros beschäftigt sich hier niemand...

Fred_BS · 25. Oktober 2020

Schau Dir mal das ContactItem-Objekt an, da wirst Du fündig, Informationen gibt es z. B. hier: https://docs.microsoft.com/de-de/off...ok.contactitem

Gruß
Fred

Toulousi · 25. Oktober 2020

Okay. Danke perfekt, das hilft schon mal.

Jetzt hab ich nur das Problem das mir der VBA-Code fehlt.

Ich würde also gerne einen einzelnen Kontakt aus Outlook in einen Access-Tabelle einfügen.

fredfred · 25. Oktober 2020

Hier mal was ich im Netz gefunden habe und angepaßt habe für Access.
Code:

Sub KontakteExportieren()
Dim rs As DAO.Recordset
Dim objoutlook
Dim objNamespace
Dim colContacts
Dim objContact
Set rs = CurrentDb.OpenRecordset("T1")

On Error Resume Next

Const olFolderContacts = 10

Set objoutlook = CreateObject("Outlook.Application")
Set objNamespace = objoutlook.GetNamespace("MAPI")

Set colContacts = objNamespace.GetDefaultFolder(olFolderContacts).Items
With rs

For Each objContact In colContacts
.AddNew
!Feld1 = objContact.FullName
!Feld2 = objContact.BusinessTelephoneNumber
!Feld3 = objContact.FirstName
!Feld4 = objContact.LastName
.Update
Next
.close
set rs = nothing
End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Toulousi · 25. Oktober 2020

Vielen Dank.

Gefunden hab ich das auch. Aber ich will nur einen einzelnen Kontakt.

Unser globales Adressbuch der Firma hat etwa 20.000 Kontakte
und die möchte ich nicht alle importieren.

Soweit bin ich gekommen.

Aber nachdem ich beim Adressdialog auf Okay drücke, gehts nicht mehr weiter.

Code:

Sub KontaktImportieren()
Dim olAnwendung As Object
Dim adressdialog As Object
Dim appoutlook As Object
Dim adresselectionDialog As Object

Set olAnwendung = CreateObject("Outlook.Application")
Set adressdialog = olAnwendung.session.getselectnamesdialog

DoEvents
olAnwendung.activewindow.Activate
If adressdialog.display Then
If TypeName(adressdialog.recipients) "nothing" Then
Set adresselectionDialog = adressdialog.recipients

Form_frmKontakte.Nachname.Value = adresselectionDialog.Item(0).Name (Hier kommt der Fehler)

End If
End If
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

fredfred · 25. Oktober 2020

ah, ok, es wird ein Suchformular aufgemacht....

Unter Umständen würde ich den Suchvorgang über Access anstoßen.

Wenn du eine Fehlermeldung erhälst dann bitte auch beschreiben, was das für ein Fehler ist.

Code:

'.........
For Each objContact In colContacts

If objContact.FullName = "Irgendwas" Then
.AddNew
!Feld1 = objContact.FullName
!Feld2 = objContact.BusinessTelephoneNumber
!Feld3 = objContact.FirstName
!Feld4 = objContact.LastName

.Update
Exit Sub
End If
Next
'............
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

"Irgendwas" steht jetzt nur mal so drin. Entweder übergibt man per Formular den gewünschten Namen oder per INputbox.

knobbi38 · 25. Oktober 2020

Hallo,

du mußt schon überlegen, ob du über Adressen oder Kontakte einsteigen möchtest und wie ein Item gefunden werden soll.

Wenn du von Access aus per Automation etwas finden möchtest, geht das z.B. mit den Items-Methoden Restrict() oder Find() mit Jet- oder DASL-Syntax.

Hier ein Beispiel, für die Find-Methode mit Jet-Syntax:
Code:

Public Sub Demo_Find_OutlookContact()
Dim appOutlook As Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objContacts As Outlook.Items
Dim objContact As Outlook.ContactItem
Dim objItems As Outlook.Items
Dim objItem As Object
Dim strCriteria As String

On Error GoTo ErrorHandler

Set appOutlook = CreateObject("Outlook.Application")
Set objNamespace = appOutlook.GetNamespace("MAPI")
Set objContacts = objNamespace.GetDefaultFolder(olFolderContacts).Items

' Find contacts for Lastname = MyName
strCriteria = "[Lastname]='MyName'"
Set objItems = objContacts.Find(strCriteria)

For Each objItem In objItems
If objItem.Class = olContact Then
' Use ContactItem class interface
Set objContact = objItem

With objContact
' Todo: process contact item
Debug.Print .FirstName & ", " & .LastName & " - " & .Department
End With
End If
Next

ErrorHandlerExit:
' Cleanup
Set objItem = Nothing
Set objItems = Nothing
Set objContact = Nothing
Set objContacts = Nothing
Set objNamespace = Nothing
Set appOutlook = Nothing
Exit Sub

ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: "
Resume ErrorHandlerExit
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruß Ulrich

Toulousi · 25. Oktober 2020

Guten Morgen,

also entweder bin ich so doof, steh auf dem Schlauch oder hab mich einfach falsch ausgedrückt.

Viellecht kann ich es nochmal verdeutlichen. Hab auch eine Bsp.-Datenbank.

1. Ich betätige den Button "Kontakt hinzufügen"
2. Outlook Dialog geht auf bei welchen ich aus dem Adressbuch "Offline Global Address List" nach einen Kontakt suchen kann, und von diesem dann
Vorname, Name, Abteilung, Telefon und E-Mailadresse,
in einem neuen Datensatz ins Formular eingetragen wird.

Der Dialog, welcher sich über die Microsoft Kontakte Vorlage öffnet, sieht aus wie in dem anhängendem Foto.

Gerne auch irgendwie anders. Hauptsache es funktioniert. Wichtig ist ich benötige die 5 obenstehenden Felder.

fredfred · 25. Oktober 2020

Der Vorschlag war unter Umgehung des Dialogformulars aus den Kontakten heraus, die Automation über Access zu realisieren.
D.h. du gibst den gesuchten Namen unter der Access-Umgebung vor.

Desweiteren lässt du nach wie vor offen, welche Fehlermeldung du bekommst, bei deinem Versuch.

Wenn ich deinen Code teste, erhalte ich unter Item(0) einen Indexfehler. In item(1) steht dann die email-Adresse.

Toulousi · 25. Oktober 2020

Okay. Hast recht mit 1 statt 0 funktioniert es.

Bleibt immer noch das Problem mit den restlichen Feldern. also Name, Vorname Abteilung, Telefonnummer

Office: (Office 2016) Abteilung aus Outlook-Kontakte

Abteilung aus Outlook-Kontakte

Abteilung aus Outlook-Kontakte

Abteilung aus Outlook-Kontakte

Abteilung aus Outlook-Kontakte

Abteilung aus Outlook-Kontakte

Abteilung aus Outlook-Kontakte - Similar Threads - Abteilung Outlook Kontakte

CSV in Outlook

Eingebundene Telefonlisten aus dem Sharepoint sind in der neuen Ansicht nicht sichtbar

Outlook 2019: Schriftart der Ordner/Posteingang ändern

Excel Termin in Outlook Kalender

Erneute Installation von Outlook

Einrichten eines Buchungskalenders für ein Unternehmen oder eine Abteilung

Verschiedene Abteilungen mit gleichem Planner auf Teams