Office: (Office 2010) öffentlichen Kontakte Ordner abfragen

Helfe beim Thema öffentlichen Kontakte Ordner abfragen in Microsoft Access Hilfe um das Problem gemeinsam zu lösen; Hallo zusammen, ich bin schon seit Tagen dran eine Lösung zufinden. Ich möchte einen bestimmten Ordner aus unseren öffentlichen Kontakten auslesen.... Dieses Thema im Forum "Microsoft Access Hilfe" wurde erstellt von magic1708, 8. Dezember 2014.

Seite 1 von 2

MAGIC1708

magic1708

öffentlichen Kontakte Ordner abfragen

Hallo zusammen,

ich bin schon seit Tagen dran eine Lösung zufinden.

Ich möchte einen bestimmten Ordner aus unseren öffentlichen Kontakten auslesen.

Mehrere Möglickeiten habe ich schon versucht. Die meisten konnten zwar auf meine eigenen Kontakte zugreifen aber nicht auf die öffentlichen.

Ich hatte aber folgendes im office-Lösungs Forum gefunden:

http://www.*************************127738_0_0_asc.php

Das habe ich wie folgt umgebaut:

Funktion:
Code:

Public Function GetPublicFolder(subPath As String) As MAPIFolder
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim strFolderPath As String
Dim arrFolders() As String
Dim I As Long
On Error Resume Next

Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")

' ### Pfad zum Alle Öffentlichen Ordner. Varianten sind mit einer Pipe "|" getrennt ###
strFolderPath = _
"Öffentliche Ordner - " & objNS.CurrentUser.Name & _
"|Öffentliche Ordner - " & objNS.CurrentUser.AddressEntry.GetExchangeUser.PrimarySmtpAddress & _
"|Öffentliche Ordner - " & objNS.CurrentUser.AddressEntry.GetExchangeUser.LastName & _
"|Öffentliche Ordner - " & objNS.CurrentUser.AddressEntry.GetExchangeUser.Alias & _
"|Öffentliche Ordner" & _
"\Alle Öffentlichen Ordner\" & subPath

strFolderPath = Replace(strFolderPath, "/", "\")
strFolderPath = Replace(strFolderPath, "|", "\")
arrFolders() = Split(strFolderPath, "\")
Set objFolder = Nothing

For I = 0 To UBound(arrFolders)
If objFolder Is Nothing Then
Set objFolder = objNS.Folders(arrFolders(I))
Else
Set colFolders = objFolder
Set objFolder = objFolder.Folders(arrFolders(I))
If objFolder Is Nothing Then
objFolder = colFolders
End If
End If
Next

If (objFolder Is Nothing Or objFolder.Name arrFolders(UBound(arrFolders))) Then
MsgBox "Ordner nicht gefunden!", , "Achtung"
End
End If

Set GetPublicFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Aufruf:

Sub Test()

Dim objFolder As MAPIFolder
Set objFolder = GetPublicFolder("NL MZ/Kontakte NL MZ/Lieferanten")
MsgBox objFolder.Name
End Sub

Ich bekomme jetzt aber nur eine Meldung mit dem Namen des Ordners.
Soweit ok. Das heißt er hat Ihn gefunden.

Ich möchte aber am liebsten die Kontakte auslesen und Final in eine Tabelle schieben.

WIe bekomme ich das hin?

Vielen Dank schon mal.

:)

magic1708, 8. Dezember 2014

#1
WB_3001

wb_3001

Hallo Matthias!

Schau mal unter http://www.mrexcel.com/forum/excel-q...a-outlook.html
Beitrag #10

Zwar für Excel, die Logik ist aber auch für Access verwendbar.

Wolfgang

wb_3001, 11. Dezember 2014

#2
MAGIC1708

magic1708

Hallo,

ich muss mein altes THema noch mal aufgreifen.

Ich habe mir folgenden Code aus einigen Beiträgen zusammen gebaut.

Code:

Sub Test()
Dim objFolder As MAPIFolder
Set objFolder = GetPublicFolder("NL MZ/Kontakte NL MZ/Lieferanten")
MsgBox objFolder.Name
End Sub

Public Function GetPublicFolder(subPath As String) As MAPIFolder
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim strFolderPath As String
Dim arrFolders() As String
Dim I As Long
On Error Resume Next

Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")

' ### Pfad zum Alle Öffentlichen Ordner. Varianten sind mit einer Pipe "|" getrennt ###
strFolderPath = _
"Öffentliche Ordner - " & objNS.CurrentUser.Name & _
"|Öffentliche Ordner - " & objNS.CurrentUser.AddressEntry.GetExchangeUser.PrimarySmtpAddress & _
"|Öffentliche Ordner - " & objNS.CurrentUser.AddressEntry.GetExchangeUser.LastName & _
"|Öffentliche Ordner - " & objNS.CurrentUser.AddressEntry.GetExchangeUser.Alias & _
"|Öffentliche Ordner" & _
"\Alle Öffentlichen Ordner\" & subPath

strFolderPath = Replace(strFolderPath, "/", "\")
strFolderPath = Replace(strFolderPath, "|", "\")
arrFolders() = Split(strFolderPath, "\")
Set objFolder = Nothing

For I = 0 To UBound(arrFolders)
If objFolder Is Nothing Then
Set objFolder = objNS.Folders(arrFolders(I))
Else
Set colFolders = objFolder
Set objFolder = objFolder.Folders(arrFolders(I))
If objFolder Is Nothing Then
objFolder = colFolders
End If
End If
Next

If (objFolder Is Nothing Or objFolder.Name arrFolders(UBound(arrFolders))) Then
MsgBox "Ordner nicht gefunden!", , "Achtung"
End
End If

Set GetPublicFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich bekomme auch die MSGBox mit dem korrekten Verzeichnis.

ABER wie komme ich nun von hier dorthin das ich alle EInträge mit definierten Feldern in eine Tabelle importiere?

magic1708, 18. März 2015

#3
WB_3001

wb_3001

öffentlichen Kontakte Ordner abfragen

Hallo Matthias!

Ich bekomme auch die MSGBox mit dem korrekten Verzeichnis.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wo in Deinem Code bekommst Du die MsgBox mit dem korrekten Verzeichnis?

Wie weit kommst Du überhaupt?
Ab wo weißt Du nicht weiter?

Was willst Du mit der Variablen strFolderPath erreichen?
Du mußt Outlook-Ordner immer rekursiv abarbeiten.
Hat er den gesuchten Namen, dann ist er weiter zu verarbeiten.

Mein Outlook hat leider keine öffentlichen Ordner. Daher kann ich deinen Code nicht testen.
Nähere Infos zu Kontakten auch unter http://msdn.microsoft.com/en-us/libr.../ff868407.aspx

Übrigens ist
End
kein guter Ausstieg aus einer Funktion. Alle mit Set angelegten Objekte bleiben dann ja alloziert.

Wolfgang

wb_3001, 19. März 2015

#4
MAGIC1708

magic1708

Hallo,

im Prinzip suche ich einen Code mit dem ich aus einem Outlook Ordner und UnterOrdner der Öffentlichen Ordner Kontakte auslesen kann.

Name VOrname Mail und Tel.

Mehr soll es nciht sein.

Ich hatte jetzt auch schon andere Code´s probiert.

z.B.

Code:

Public Sub readGAL()
Dim oOutlook As Object
Dim oAddressList As Object
Dim oAddressEntry As Object
Dim oExchangeUser As Object

' -----------------------
' Outlook-Instanz anlegen
' -----------------------
Set oOutlook = CreateObject("Outlook.Application")

' -----------------------------
' Alle Adress-Listen durchgehen
' -----------------------------
For Each oAddressList In oOutlook.Session.AddressList.Item("Lieferanten_MZ")
' -------------------------
' Prüfen, ob Exchange-Liste
' -------------------------
If oAddressList.AddressListType = olExchangeGlobalAddressList Then
' -------------------------------
' Alle Adress-Einträge durchgehen
' -------------------------------
For Each oAddressEntry In oAddressList.AddressEntries
' -------------------------
' Prüfen, ob Adress-Eintrag
' -------------------------
If oAddressEntry.AddressEntryUserType = olExchangeUserAddressEntry _
Or oAddressEntry.AddressEntryUserType = olExchangeRemoteUserAddressEntry Then
' --------------------------
' Eintrag von Exchange laden
' --------------------------
Set oExchangeUser = oAddressEntry.GetExchangeUser

Debug.Print oExchangeUser.Name & ": " & oExchangeUser.Department
End If
Next
End If
Next

' ------------------------
' Objektvariable freigeben
' ------------------------
Set oExchangeUser = Nothing
Set oAddressEntry = Nothing
Set oAddressList = Nothing
Set oOutlook = Nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das rot markierte ist aber eine ergänzung von mir. DIe habe ich so noch nicht zum laufen bekommen.

Ohne die Ergänzung durchläuft er alle Ordner und Listet die an.

Ein Bestimmter wäre aber ausreichend.

magic1708, 19. März 2015

#5
WB_3001

wb_3001

Hallo Matthias!

Das rot markierte ist aber eine ergänzung von mir. DIe habe ich so noch nicht zum laufen bekommen.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Da stimmt die Syntax nicht. Schau unter
https://msdn.microsoft.com/en-us/lib...ffice.11).aspx

Wolfgang

wb_3001, 19. März 2015

#6
MAGIC1708

magic1708

Hallo,

Danke für deine HIlfe !

Ich habe mal versucht es so einzubauen.

Bin aber noch nicht auf die Lösung gestoßen!

Code:

ublic Sub readGAL()
Dim oOutlook As Object
Dim oAddressList As Object
Dim oAddressEntry As Object
Dim oExchangeUser As Object

' -----------------------
' Outlook-Instanz anlegen
' -----------------------
Set oOutlook = CreateObject("Outlook.Application")
Set oAddressList = Application.Session.AddressLists("Lieferanten_MZ")

' -----------------------------
' Alle Adress-Listen durchgehen
' -----------------------------
For Each oAddressList In oOutlook.Session.AddressLists

' -------------------------
' Prüfen, ob Exchange-Liste
' -------------------------
If oAddressList.AddressListType = olExchangeGlobalAddressList Then
' -------------------------------
' Alle Adress-Einträge durchgehen
' -------------------------------
For Each oAddressEntry In oAddressList.AddressEntries
' -------------------------
' Prüfen, ob Adress-Eintrag
' -------------------------
If oAddressEntry.AddressEntryUserType = olExchangeUserAddressEntry _
Or oAddressEntry.AddressEntryUserType = olExchangeRemoteUserAddressEntry Then
' --------------------------
' Eintrag von Exchange laden
' --------------------------
Set oExchangeUser = oAddressEntry.GetExchangeUser

Debug.Print oExchangeUser.Name & ": " & oExchangeUser.Department
End If
Next
End If
Next

' ------------------------
' Objektvariable freigeben
' ------------------------
Set oExchangeUser = Nothing
Set oAddressEntry = Nothing
Set oAddressList = Nothing
Set oOutlook = Nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Er markert mir dann das .Session an und meint das er die Methode nicht findet.

magic1708, 20. März 2015

#7
MAGIC1708

magic1708

öffentlichen Kontakte Ordner abfragen

hallo,

ein weiterer Versuch. Scheinbar hänge ich aber immer an der gleichen Stelle !

Code:

Sub KontakteausOutlook()

Dim appout As Object
Dim objArbeitsverz As Object
Dim objKon As Object
Dim rst As Recordset
Dim dbs As Database
Dim intz As Integer
Dim intneu As Integer
Dim intupd As Integer
Dim strNachname As String
Dim strvorname As String

intz = 0
intneu = 0
intupd = 0

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Kontakte", dbOpenDynaset)

Set appout = CreateObject("Outlook.Application")
Set objArbeitsverz = _
appout.GetNamespace("MAPI").AddressLists("Lieferanten_MZ").AddressEntries() 'GetDefaultFolder(olFolderContacts)

For intz = 1 To objArbeitsverz.Items.Count
Set objKon = objArbeitsverz.Items(intz)
strNachname = objKon.LastName
strvorname = objKon.FirstName
strNachname = "nachname = '" & strNachname & "'"

With objKon
rst.FindFirst strNachname
If rst.NoMatch Then
rst.AddNew
rst!nachname = .LastName
rst!Vorname = .FirstName
rst!Straße = .BusinessAddressStreet
rst!PLZ = .BusinessAddressPostalCode
rst!Ort = .BusinessAddressCity
rst!Bundesland = .BusinessAddressState
rst!Telefon = .BusinessTelephoneNumber
rst!Fax = .BusinessFaxNumber
'rst!Geburtstag = .Birthday
rst!mail = .Email1Address
intneu = intneu + 1
Else
If rst!Vorname = strvorname Then
rst.Edit
rst!Straße = .BusinessAddressStreet
rst!PLZ = .BusinessAddressPostalCode
rst!Ort = .BusinessAddressCity
rst!Bundesland = .BusinessAddressState
rst!Telefon = .BusinessTelephoneNumber
rst!Fax = .BusinessFaxNumber
'rst!Geburtstag = .Birthday
rst!mail = .Email1Address
intupd = intupd + 1
Else
rst.AddNew
rst!nachname = .LastName
rst!Vorname = .FirstName
rst!Straße = .BusinessAddressStreet
rst!PLZ = .BusinessAddressPostalCode
rst!Ort = .BusinessAddressCity
rst!Bundesland = .BusinessAddressState
rst!Telefon = .BusinessTelephoneNumber
rst!Fax = .BusinessFaxNumber
'rst!Geburtstag = .Birthday
rst!mail = .Email1Address
intneu = intneu + 1
End If
End If
End With

rst.Update
Next intz
MsgBox "Datentransfer erfolgreich beendet! " & vbLf & _
"Es wurden " & intneu & "Sätze angelegt, " & vbLf & _
"Es wurden " & intupd & "Sätze aktualisiert!"
rst.Close

Exit Sub

Fehler:
MsgBox Err.Number & " " & Err.Description
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Der Grüne Bereich unterstütz die Methode nicht.... Scheinbar löse ich den Pfad oben nciht richtig auf.

magic1708, 20. März 2015

#8
MAGIC1708

magic1708

Achso. Der letztere Code bewirkt mit dem DefaultOrdner genau das was ich brauche.

jedoch im Falschen Ordner.

magic1708, 20. März 2015

#9
WB_3001

wb_3001

Hallo Matthias!

Mir scheint, daß Du auf gut Glück herumexperimentierst, ohne den Aufbau der Outlook-Folder wirklich zu verstehen.

Hier ein Code einzufügen in ein allg. Modul, der alle Folder samt Subfolder auflistet:

Code:

'
' Ermitteln aller OL-Ordner
'
Sub All_OL_Folders()
On Error Resume Next
Dim oOutlook As Outlook.Application
Dim oNs As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim iIndent As Integer

FileNumber = FreeFile()
' Open Pfadname For Modus [Access Zugriff] [Sperre] As [#]Dateinummer [Len=Satzlänge]
Open CurrentProject.Path & "\OLAllFolders.txt" For Output As FileNumber

Print #FileNumber, CurrentProject.Name & ": " & Now() & " Beginn der Auswertung aller OL-Ordner"
iIndent = 1
Set oOutlook = CreateObject("Outlook.Application")
Set oNs = oOutlook.GetNamespace("MAPI")

For Each olFolder In oNs.Folders
Call RecurseAllFolders(olFolder, iIndent)
Next olFolder

Print #FileNumber, "Ende der Auswertung aller OL-Ordner"
Close #FileNumber
Set olFolder = Nothing
Set oNs = Nothing
Set oOutlook = Nothing
End Sub
'
' Ermitteln aller Subfolder eines Folders
'
Private Sub RecurseAllFolders(CurrentFolder As Outlook.MAPIFolder, ByVal iIndent As Integer)
On Error Resume Next

Dim Folders As Outlook.Folders
Dim SubFolder As Outlook.MAPIFolder
Dim lEndLoop As Long
Dim lX As Long

Print #FileNumber, Space(iIndent * 3) & "Folder:"; CurrentFolder.Name;
Print #FileNumber, ", " & strOLObjects(CurrentFolder.DefaultItemType);
Print #FileNumber, ", Anzahl Verzeichnisse:"; CurrentFolder.Folders.Count;
Print #FileNumber, ", Anzahl Zeilen:"; CurrentFolder.Items.Count

iIndent = iIndent + 1
Set Folders = CurrentFolder.Folders
For Each SubFolder In Folders
Call RecurseAllFolders(SubFolder, iIndent)
Next SubFolder
Cont:
Set SubFolder = Nothing
Set Folders = Nothing
Exit Sub

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

Mit Call All_OL_Folders wird ein Textfile im selben Verzeichnis der DB erstellt,
der alle Outlook-Folder und die darin enthaltenen Subfolder samt Zeilenanzahl jeweils hereingerückt auflistet.

Anhand dieser Liste, kannst Du prüfen, wie und wo Du den Code für Deine Zwecke erweitern mußt.

Wahrscheinlich mußt Du die Outlook Object-Library in den Verweisen hinzufügen.

Wolfgang

wb_3001, 21. März 2015

#10
MAGIC1708

magic1708

Hallo,

da gebe ich dir Recht. Den richtigen Durchblick habe ich noch nicht.

ich habe deinen Code eingebaut. Der Verweis auf die outlook objekt Libary hatte ich schon gesetzt.

Der INhalt deiner Datei ist folgender:

Telefonliste.accdb: 21.03.15 18:07:05 Beginn der Auswertung aller OL-Ordner
Ende der Auswertung aller OL-Ordner
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Sonst steht da nix drin.

Ich musste auch für 2 Dinge die Variablen Konfigurieren:

FileNumber und strOLObjects

ist das so korrekt?

Liebe Grüße Matthias

magic1708, 21. März 2015

#11
WB_3001

wb_3001

Hallo Matthias!

Ich verwende normalerweise Office 2003.
Doch habe ich jetzt die DB in das A2010 Format konvertiert.
Ebenso Outlook.
Der Code funktioniert auch unter Office 2010!

FileNumber und strOLObjects anzulegen war ok.

Hast Du mittels Einzelschritts geprüft, wo der Code aussteigt?
Es gibt wahrscheinlich einen simplen Grund, warum bei Dir überhaupt kein Ordner gefunden wird.
Ist Dein OL vielleicht als Exchange-Client konfiguriert? Das könnte ich hier leider gar nicht testen.

Der Anhang zeigt die Auswertung aller Ordner meines Outlook 2010.

Wolfgang

wb_3001, 21. März 2015

#12
WB_3001

wb_3001

öffentlichen Kontakte Ordner abfragen

Hallo Matthias!

Noch eine Ergänzung: Setze versuchsweise in All_OL_Folders
Code:

On Error Resume Next
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

unter Kommentar.

Wolfgang

wb_3001, 21. März 2015

#13
WB_3001

wb_3001

Hallo Matthias!

Um sicherzustellen, daß ich in einem Modul der Ordnerermittlung
nicht übersehen habe, Variable zu definieren, habe ich eine neue DB erstellt und hier hochgeladen, die nur diese Outlook-Ordnerermittlung enthält.

Sie hat das Format A2003.

Wolfgang

wb_3001, 22. März 2015

#14
MAGIC1708

magic1708

Hey,

ich hänge an einem Exchange Server dran. Habe keine eigene PST.

magic1708, 22. März 2015

#15

(Du musst angemeldet oder registriert sein, um eine Antwort erstellen zu können.)

Seite 1 von 2

Thema:

öffentlichen Kontakte Ordner abfragen

Die Seite wird geladen...

öffentlichen Kontakte Ordner abfragen - Similar Threads - öffentlichen Kontakte Ordner
Öffentlicher Ordner Kontakte aktualisieren
in Microsoft Outlook Hilfe
Öffentlicher Ordner Kontakte aktualisieren: Hallo liebes Forum, ich habe kürzlich administrative Aufgaben für eine Firma übernommen und die Aufgabe erhalten sämtliche Kontakte des öffentlichen Ordner (GAL) auf die neue Geschäfts Adresse...
Öffentliche Ordner - Gelesen/Ungelesen Einstellung
in Microsoft Outlook Hilfe
Öffentliche Ordner - Gelesen/Ungelesen Einstellung: Guten Tag, wir wollen in unserem Unternehmen einen öffentlichen Ordner zum Austausch von Mails nutzen. Mitarbeiter sollen Mails, die für alle anderen Mitarbeiter auch von Interesse sind, in...
Teams Liveereignis als öffentlich konfigurieren
in Microsoft Teams Hilfe
Teams Liveereignis als öffentlich konfigurieren: Hallo zusammen, ich möchte mein Teams Liveereignis für jedermann zur Verfügung stellen. Ich habe die globale Policy wie folgt eingestellt: [ATTACH] Im Teams Client bleibt aber das Feld grau:...
Öffentliche Besprechung in Microsoft Teams
in Microsoft Teams Hilfe
Öffentliche Besprechung in Microsoft Teams: Hallo, es wurde eine Besprechung in Teams über einen Kalendereintrag erstellt. Über die Besprechungsoptionen wurde das umgehen des Warteraumes für alle erlaubt. Im Teams Admin Center wurde der...
Kanal in einem Team von privat auf öffentlich stellen
in Microsoft Teams Hilfe
Kanal in einem Team von privat auf öffentlich stellen: Hallo Community, ich habe im Teams für Unternehmen einen privaten Kanal angelegt und möchte ihn nun auf öffentlich umstellen. Ich finde in Teams und hier im Forum nicht die Möglichkeit dafür....
Öffentliche Kontakte
in Microsoft Outlook Hilfe
Öffentliche Kontakte: Guten Tag liebes Forum, ich habe heute einen Fehler von einem Kollegen berichtet bekommen. Dieser Fehler passiert in Office 2013. Und zwar er würde gerne die Öffentlichen Kontakte Lokal auf...
Bestimmte Kontake aus öffentlichen Kontakten synchronisieren
in Microsoft Outlook Hilfe
Bestimmte Kontake aus öffentlichen Kontakten synchronisieren: Hallo, kennt ihr eine Möglichkeit nur bestimmte Kontakte aus den öffentlichen Kontakten in die eigenen Kontakte zu verschieben. Diese werden dann bei zentralen Änderungen in den öffentlichen...

Anmelden oder registrieren

Suche

Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.

Akzeptieren Weitere Informationen...

Information ausblenden