Sub OutlAddressList()
Dim lRow As Long
Dim OutlApp As Outlook.Application
Dim NameSp As NameSpace
Dim AdrLsts As AddressLists
Dim AdrLst As AddressList ' Returns the AddressEntries collection
Dim AdrEntrs As AddressEntries
Dim AdrEntr As AddressEntry
On Error Resume Next
Err.Clear
Set OutlApp = New Outlook.Application
Set NameSp = OutlApp.GetNamespace("MAPI")
' The AddressLists collection represents the root of the address book
' hierarchy for the current session. A particular AddressList object
' represents one of the available address books.
Set AdrLsts = NameSp.AddressLists
lRow = 0
For Each AdrLst In AdrLsts
Set AdrEntrs = AdrLst.AddressEntries
For Each AdrEntr In AdrEntrs
lRow = lRow + 1
Cells(lRow, 1).Value = AdrLst.Name
Cells(lRow, 2).Value = AdrEntr.Address
Next AdrEntr
Next AdrLst
' OutlApp.Quit
Set OutlApp = Nothing
If (Err.Number <> 0) Then MsgBox "Error Nr. : " & Err.Number
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen