Article ID: 172093
Article Last Modified on 10/25/2007
Option Explicit
Sub main()
Dim objSession As MAPI.Session ' Use early binding for
' efficiency.
Dim collAddressLists As AddressLists
Dim objAddressList As AddressList
Dim collAddressEntries As AddressEntries
On Error GoTo error_olemsg
' Create a session and log on.
Set objSession = CreateObject("MAPI.Session")
' Use a valid Exchange profile name.
objSession.Logon ("<Your Profile Name Here>")
'Walk the available address books.
Set collAddressLists = objSession.AddressLists
For Each objAddressList In collAddressLists
' Display collection selection indices.
Debug.Print objAddressList.Name,
Debug.Print objAddressList.Index,
' Display the readonly access flag.
Debug.Print objAddressList.IsReadOnly,
' Display the count of recipients.
Set collAddressEntries = objAddressList.AddressEntries
Debug.Print Str(collAddressEntries.Count)
' If there are any AddressEntries, display the first recipient name.
If Not objAddressList.AddressEntries(1) Is Nothing Then _
Debug.Print objAddressList.AddressEntries(1).Name
Next objAddressList
' Walk the global address list.
Set collAddressEntries = objSession.AddressLists( _
"Global Address List").AddressEntries
WalkAddressList collAddressEntries
' Close the session and log off.
objSession.Logoff
Exit Sub
error_olemsg:
MsgBox "Error " & Str(Err) & ": " & Error$(Err)
Exit Sub
End Sub
' Walk an AddressEntries collection and recursively expand
' Distribution Lists.
Sub WalkAddressList(collAddressEntries As AddressEntries)
Dim objaddressEntry As AddressEntry
For Each objaddressEntry In collAddressEntries
' Display the recipient's name.
Debug.Print objaddressEntry.Name,
' Display the recipient's type.
Select Case objaddressEntry.DisplayType
Case ActMsgUser
Debug.Print "Exchange Recipient"
Case ActMsgDistList
Debug.Print "Distribution List"
WalkAddressList objaddressEntry.Members
Debug.Print "End of DL " & objaddressEntry.Name
Case ActMsgForum
Debug.Print "Public Folder"
Case ActMsgAgent
Debug.Print "Agent"
Case ActMsgPrivateDistList
Debug.Print "Private DL"
Case ActMsgOrganization
Debug.Print "Organization"
Case ActMsgRemoteUser
Debug.Print "Custom Recipient"
Case Else
Debug.Print "Unknown type"
End Select
Next objaddressEntry
End Sub171440 Where to acquire the CDO Libraries (all versions)
Keywords: kbhowto kbprogramming KB172093