'********************************************************************************
' Description: Exports all distribution lists to CSV
'********************************************************************************
dim filename, props
filename = "2003DistributionLists.csv"
props = array("displayName","sAMAccountName",”Mail”,”mailNickname”)
'********************************************************************************
' Helper Functions
'********************************************************************************
function RetrieveUsers()
dim rootDse, defaultNamingContext, ldapQuery, ldap, conn, rs
set rootDse = GetObject("LDAP://RootDSE")
defaultNamingContext = rootDse.Get("defaultNamingContext")
ldapQuery = "(&(objectClass=group)(mailNickname=*)(mail=*))"
ldap = "<LDAP://" & defaultNamingContext & ">;" & ldapQuery & ";adspath;subtree"
set conn = CreateObject("ADODB.Connection")
conn.Provider = "ADsDSOObject"
conn.Open "Active Directory Provider"
set RetrieveUsers = conn.Execute(ldap)
end function
function ArrayToString(value)
dim firstValue, result
firstValue = true
result = ""
for i=0 to UBound(value)
if not firstValue then
result = result + ";"
end if
result = result + value(i)
firstValue = false
next
ArrayToString = result
end function
function DnToEmailAddress(dn)
dim ldap, mail
mail = ""
ldap = "LDAP://" & dn
set user = GetObject(ldap)
on error resume next
mail = user.Get("mail")
on error goto 0
DnToEmailAddress = mail
end function
function Main()
dim value, fso, shell, users, firstProp, dns, firstDn, memberEmail, emailAddress
set fso = CreateObject("Scripting.FileSystemObject")
set csv = fso.CreateTextFile(filename)
if not err.number = vbEmpty then
msgbox err.message, 0, "ExportError"
exit function
end If
comma = false
for each prop in props
if comma then
csv.Write(",")
end if
csv.Write("""")
csv.Write(prop)
csv.Write("""")
comma = true
next
csv.WriteLine(",""memberEmail""")
set users = RetrieveUsers()
while not users.EOF
set user = GetObject(users.Fields(0).Value)
memberEmail = ""
firstProp = true
for each prop in props
if not firstProp then
csv.Write(",")
end if
csv.Write("""")
value = ""
on error resume next
value = user.Get(prop)
if IsArray(value) then
value = ArrayToString(value)
if "member" = prop then
dns = Split(value, ";")
firstDn = true
for i=0 to UBound(dns)
emailAddress = DnToEmailAddress(dns(i))
if not "" = emailAddress then
if not firstDn then
memberEmail = memberEmail + ";"
end if
memberEmail = memberEmail + emailAddress
firstDn = false
end if
next
end if
end if
csv.Write(value)
on error goto 0
csv.Write("""")
firstProp = false
next
csv.WriteLine(",""" & memberEmail & """")
users.MoveNext
wend
csv.Close
set csv = nothing
set fso = nothing
Set shell = CreateObject("WScript.Shell")
shell.run ("Explorer" & " ." )
end function
Main
