Expand Outlook Distribution List using Excel VBA

Const olFolderContacts = 10
 
Sub DistList()
    Dim objApp As Object, objNS As Object
    Dim objFolder As Object, objDist As Object
    Dim objAddrEntry As Object
    Dim MyList As String
    Dim ws As Worksheet
     
    Set ws = ActiveWorkbook.Worksheets.Add
     
    MyList = "mylist" ' change your list name here and it should be in your contacts
    Set objApp = CreateObject("Outlook.Application")
    Set objNS = objApp.GetNamespace("MAPI")
    Set objFolder = objNS.GetDefaultFolder(olFolderContacts)
    On Error Resume Next
    Set objDist = objFolder.Items(MyList)
    On Error GoTo 0
    If objDist Is Nothing Then
        MsgBox "Distribution List doesn't exist", vbCritical
        GoTo fastexit
    End If
     
    For i = 1 To objDist.MemberCount
        Set objAddrEntry = objDist.GetMember(i).AddressEntry
        Cells(i, 1) = objAddrEntry.Name
        Cells(i, 2) = objAddrEntry.Address
    Next
fastexit:
    Set objFolder = Nothing
    Set objApp = Nothing
End Sub