Getting Names fron Outlook

[Office_Novice]

This Works great if I want everything. However I only want the names in a
specific Distribution List. Is there a way to break this down to that level?

Option Explicit

Public Sub DisplayOutlookContactNames()
Dim Outlook As Outlook.Application
Dim NameSpace As Outlook.NameSpace
Dim AddressList As AddressList
Dim Entry As AddressEntry
Dim I As Long

On Error GoTo Finally

Set Outlook = New Outlook.Application
Set NameSpace = Outlook.GetNamespace("MAPI")
Set AddressList = NameSpace.AddressLists("All Contacts")
For Each Entry In AddressList.AddressEntries
I = I + 1
Cells(I, 1).Value = Entry.Name
Next

Finally:
Outlook.Quit
Set Outlook = Nothing
End Sub

 

[Dick Kusleika]

This Works great if I want everything. However I only want the names in a
specific Distribution List. Is there a way to break this down to that level?

Option Explicit

Public Sub DisplayOutlookContactNames()
Dim Outlook As Outlook.Application
Dim NameSpace As Outlook.NameSpace
Dim AddressList As AddressList
Dim Entry As AddressEntry
Dim I As Long

On Error GoTo Finally

Set Outlook = New Outlook.Application
Set NameSpace = Outlook.GetNamespace("MAPI")
Set AddressList = NameSpace.AddressLists("All Contacts")
For Each Entry In AddressList.AddressEntries
I = I + 1
Cells(I, 1).Value = Entry.Name
Next

Finally:
Outlook.Quit
Set Outlook = Nothing
End Sub

Try this

Sub getdlist()

Dim ol As Outlook.Application
Dim ns As Outlook.Namespace
Dim al As Outlook.AddressList
Dim ae As Outlook.AddressEntry
Dim dle As Outlook.AddressEntry

Set ol = New Outlook.Application
Set ns = ol.GetNamespace("MAPI")
Set al = ns.AddressLists("Contacts")

For Each ae In al.AddressEntries
If ae.Type = "MAPIPDL" Then
For Each dle In ae.Members
Debug.Print dle.Name & " is in " & ae.Name
Next dle
End If
Next ae

Set al = Nothing
Set dle = Nothing
Set ae = Nothing
Set ns = Nothing
Set ol = Nothing

End Sub