Anzeige

VBA
Programmierer
gesucht?
 
Anzeige
VBA Programmierer gesucht?
 

VBA Codeschnipselsammlung

Microsoft® Outlook® Adressbuch auslesen

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)

Anzeige

VBA Programmierer gesucht?
http://www.WershovenOnline.de

Anzeige

Der Quick E-Mail Support von WershovenOnline®

Schnelle Hilfe bei Fragen rund um Microsoft® Office und VBA Makros

Der Quick E-Mail Support von WershovenOnline® 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...

Zum Seitenanfang