Outlook Adressbuch für Verteilerlisten in Access nutzen

21/10/2008 - 14:24 von Joerg M. | Report spam
Hallo NG,

Access 2003, Outlook 2003, Windows Server 2003, Exchange 2005

Ich möchte in Access Verteilerlisten zusammenstellen.
Hierzu würde ich gerne, wie beim erstellen einer Email in MS Outlook dsa
Adressbuch öffnen und die dort angezeigten möglichen Empfànger aus dem
Outlook Adressbuch bzw. dem Active Directory) auswàhlen und in eine
Access-Tabelle übertragen.

Hat das schonmal jemand gemacht?
Wie geht das?

Danke, Gruß Joerg
 

Lesen sie die antworten

#1 Dirk Eberhardt
21/10/2008 - 15:47 | Warnen spam
Hallo Joerg,

Joerg M. schrieb:
Ich möchte in Access Verteilerlisten zusammenstellen.
Hierzu würde ich gerne, wie beim erstellen einer Email in MS Outlook dsa
Adressbuch öffnen und die dort angezeigten möglichen Empfànger aus dem
Outlook Adressbuch bzw. dem Active Directory) auswàhlen und in eine
Access-Tabelle übertragen.



Ich habe das schon mal über die Outlook Redemption (RDO) von Dmitry
Streblechenko (http://www.dimastr.com/redemption/) realisiert.
Funktioniert soweit sehr gut.

Hier mein Beispiel-Code zum Einbinden:

On Error Resume Next

Const PR_GIVEN_NAME = &H3A06001E 'Nachname
Const PR_SURNAME = &H3A11001E 'Vorname

Dim objSession As RDOSession
Dim objRecipients As RDORecipients
Dim objRecipient As RDORecipient
Dim objAdressEntry As RDOAddressEntry
Dim strName As String
Dim strMailAdress As String
Dim lngCount As Long
Dim OhneEMail As Boolean
Dim r As Recordset

Set objSession = CreateObject("Redemption.RDOSession")
Call objSession.Logon
Set objRecipients = objSession.AddressBook.ShowAddressBook(, _
"Empfànger auswàhlen", , , 1, "übernehmen")
Set r = CurrentDb.OpenRecordset("taddNachrichtEmpfaenger")

If err.Number = 0 Then
For lngCount = 1 To objRecipients.Count
Set objRecipient = objRecipients.Item(lngCount)

'Kontaktdaten uebernehmen
Set objAdressEntry = objRecipient.AddressEntry
strName = objAdressEntry.Fields(PR_SURNAME) & ", " & _
objAdressEntry.Fields(PR_GIVEN_NAME)
strMailAdress = objAdressEntry.SMTPAddress
If strMailAdress = "" Then OhneEMail = True

'An Tabelle anfuegen
r.AddNew
r!fiReportNr = Me.ReportNr
r!dtEmailAdresse = strMailAdress
r!dtEmailName = strName
r.Update
Next
End If

r.Close
Set r = Nothing
Set objSession = Nothing
Set objRecipients = Nothing
Set objRecipient = Nothing
Set objAdressEntry = Nothing

'Empfaengerliste aktualisieren
Me!fsubNachrichtenEmpfaenger.Requery

'Wenn ein Kontakt ohne E-Mail-Adresse enthalten ist
If OhneEMail = True Then
Call MsgBox("Mindestens ein gewàhlter Kontakt enthielt " & _
"keine E-Mail-Adresse." & vbCrLf & vbCrLf & _
"Bitte ergànzen Sie die E-Mail-Adresse in der Liste." _
, vbInformation, Application.Name)
End If

Gruß Dirk

Ähnliche fragen