strFileName = "C:\DistList.TXT"
StrDistListName = "enter name of distribution list here"
strExcSrv = "enter name of Exchange server here"

Set fso = CreateObject("Scripting.FileSystemObject")
Set DistList = fso.OpenTextFile(strFileName, 2, True)
Set ADOconn = CreateObject("ADODB.Connection")
ADOconn.Provider = "ADSDSOObject"
ADOconn.Open "ADs Provider"
bstrADOQueryString = "<LDAP://" & strExcSrv & ">;(&(objectClass=groupOfNames)(cn=" & StrDistListName & "));*;subtree"
Set objRS = ADOconn.Execute(bstrADOQueryString)

Set objObject = GetObject(objRS.Fields(0))
objMembers = objObject.GetEx("member")
For Each member In objMembers
  Set objMember = GetObject("LDAP://" & strExcSrv & "/" & member)
  If objMember.Class = "groupOfNames" Then
    recurse_list ("LDAP://" & strExcSrv & "/" & member)
  Else
    DistList.writeline (objMember.cn & ";" & objMember.ADsPath)
  End If
  Set objMember = Nothing
Next

objRS.Close
ADOconn.Close
DistList.Close
Set objRS = Nothing
Set ADOconn = Nothing
Set objMembers = Nothing
Set DistList = Nothing

Private Function recurse_list(strPath)
  On Error Resume Next
  Set objLocObject = GetObject(strPath)
  If Err.Number <> 0 Then
     Err.Clear
  End If
  On Error GoTo 0
  On Error Resume Next
  objLocMembers = objLocObject.GetEx("member")
  If Err.Number <> 0 Then
    Err.Clear
  Else
    For Each Locmember In objLocMembers
      Set objLocMember = GetObject("LDAP://" & strExcSrv & "/" & Locmember)
      If objLocMember.Class = "groupOfNames" Then
        recurse_list (objLocMember.ADsPath)
      Else
        DistList.writeline (objLocMember.cn & ";" & objLocMember.ADsPath)
      End If
      Set objLocMember = Nothing
    Next
  End If
  On Error GoTo 0
End Function