Beispielquelltext das Adressbuch von Microsoft® Outlook® aus Excel® heraus auszulesen.
Option Explicit
' ************************************************************************************************
' Autor/en: http://www.online-vba.de - Marc Wershoven
' Verwendung der Quelltexte auf eigene Gefahr!
' Es gelten die Nutzungsbedingungen von www.online-vba.de!
' Original-Quelltext: www.online-vba.de/vba_outlookadr.php
' ************************************************************************************************
'Achtung VERWEIS im VBA Projekt setzen: "Microsoft Outlook x.x Object Library"!
'Achtung VERWEIS im VBA Projekt setzen: "Microsoft CDO x.x Library"!
Sub MWGetOutlookAdressbookEntries()
Const lNAME = &H3A06001E 'Nachname
Const lVORNAME = &H3A11001E 'Vorname
Const lALIAS = &H3A00001E 'Alias
Const lDISPLAYNAME = &H3001001E 'Angezeigter Name
Const lADDRESS = &H3A29001E 'Adresse
Const lORT = &H3A27001E 'Ort
Const lPLZ = &H3A2A001E 'Postleitzahl
Const lLAND = &H3A26001E 'Land
Const lTITEL = &H3A17001E 'Titel, Anrede
Const lFIRMA = &H3A16001E 'Firma
Const lABTEILUNG = &H3A18001E 'Abteilung
Const lMOBILHANDY = &H3A1C001E 'Mobiltelefon
Const lTELBUERO = &H3A08001F 'Telefon Geschäftlich
Const lTELHOME = &H3A09001E 'Telefon Privat
Const lEMAIL = &H39FE001E 'E-Mail
Const lSMTP = &H39FE001F
Dim oAlias As Object, oCDO As Object
Dim z As Long
Dim i As Long
Dim oADREntries As MAPI.AddressEntries
Dim oADREntry As MAPI.AddressEntry
Dim sName As String, aAdress As String
z = 2
Set oOutlookApp = GetObject(, "Outlook.Application") 'Outlook muss offen sein, alternativ umbauen!
Set oNameSpace = oOutlookApp.GetNamespace("MAPI")
Set oCDO = CreateObject("MAPI.Session")
oCDO.Logon "", "", False, False
Set oADREntries = oCDO.AddressLists.Item(1).AddressEntries
For Each oADREntry In oADREntries.Items
Application.StatusBar = CStr("VBA: MWGetOutlookAdressbookEntries --> Import " & _
i & " von " & oADREntries.Count & " Elementen...")
Set oAlias = oADREntry.Fields(CdoPR_ACCOUNT)
' Nur Einträge, welche ein E-Mail Eintrag sind werden verarbeitet
If oADREntry.DisplayType = olUser Then
sAddress = oADREntry.Fields(lSMTP).Value
sName = oADREntry.Fields(lNAME).Value
' Ausgabe auf aktivem Tabellenblatt, evtl. neues Blatt einfügen hinzufügen bei Bedarf
Cells(z, 1) = oAlias
Cells(z, 2) = sAddress
Cells(z, 3) = sName
z = z + 1
End If
Next oADREntry
Application.StatusBar = CStr("Fertig.")
MsgBox "Fertig."
End Sub
Autor: Marc Wershoven (2013)
VBA Programmierer gesucht?
http://www.WershovenOnline.de
Sie haben beispielsweise eine Frage zu einer Ihrer eigenen Makroprogrammierungen in VBA? Oder Sie suchen Unterstützung und Informationen über eine bestimmte Microsoft® Excel® Formel? Bei nahezu allen Fragen und Problemen rund um Microsoft® Office und VBA Makros steht Ihnen unser individueller Quick E-Mail Support zur Verfügung. Einfach, schnell und unkompliziert Ihre Frage in einer E-Mail formulieren, mit oder ohne Screenshots oder einer Beispieldatei absenden und kurze Zeit später haben Sie eine vollständige Lösung inkl. ausführlicher Erklärung vom Profi in Ihrem Postfach!
Zusätzlich besteht die Option, dass wir uns mittels Fernwartung (selbstverständlich nach Ihrem Einvertändnis) direkt "live" mit Ihnen zusammen an Ihrem Bildschirm gemeinsam Fragen und Problemstellungen anschauen und lösen können!
Weitere Informationen zu diesem kostenpflichtigen Angebot finden Sie auf der Anbieterseite von WershovenOnline® auf www.wershovenonline.de.
Zum Anbieter des Quick-E-Mail-Support...