Need script to generate list of all email accounts in Active Directory 2003

Posted on 2007-12-04
Last Modified: 2010-12-21
I need a script that will give me a .csv file of all email accounts in active directory (2003) .I don't need any info associated with the account,etc. Just need a list of all active email addresses.
Question by:FIFBA
LVL 70

Expert Comment

Comment Utility

Author Comment

Comment Utility
Is there a way to get the email address only into a csv file?
LVL 12

Accepted Solution

chandru_sol earned 500 total points
Comment Utility
Try this script.........

Save the script as listemail.vbs

From the command prompt where the script resides run
cscript listemail.vbs > listemailaddress.csv

Option Explicit


Dim objRootDSE, strDNSDomain, objCommand, objConnection

Dim strBase, strFilter, strAttributes, strQuery, objRecordSet

Dim strNTName, strDN, colmail, strmail, stremail, strOU


' Determine DNS domain name.

Set objRootDSE = GetObject("LDAP://RootDSE")

strDNSDomain = objRootDSE.Get("defaultNamingContext")


' Use ADO to search Active Directory.

Set objCommand = CreateObject("ADODB.Command")

Set objConnection = CreateObject("ADODB.Connection")

objConnection.Provider = "ADsDSOObject"

objConnection.Open "Active Directory Provider"

objCommand.ActiveConnection = objConnection


' Search entire domain.

strBase = "<LDAP://" & strDNSDomain & ">"


' Filter on contacts

strFilter = "(&(&(& (mailnickname=*)(| (&(objectCategory=person)(objectClass=user))))))"


' Comma delimited list of attribute values to retrieve.

strAttributes = "cn,distinguishedName,adspath,proxyaddresses"


' Construct the ADO query, using LDAP syntax.

strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"


' Run the query.

objCommand.CommandText = strQuery

objCommand.Properties("Page Size") = 100

objCommand.Properties("Timeout") = 30

objCommand.Properties("Cache Results") = False

Set objRecordSet = objCommand.Execute


' Enumerate the recordset and output the values retrieved in

' comma delimited format.

Do Until objRecordSet.EOF

strNTName = objRecordSet.Fields("cn").Value

strDN = objRecordSet.Fields("distinguishedName").Value

colmail = objRecordSet.Fields("proxyAddresses")


If IsEmpty(colMail) Then

' The attribute is empty (has no values).

wscript.echo "No Email address"


' The attribute has one or more values - enumerate.

For Each strMail In colMail

If Instr(strMail, "SMTP:") then

strEmail = Right(strMail, Len(strMail)-5)

End If


End If

Wscript.Echo strNTName & "," & strEmail





' Clean up.


Set objRootDSE = Nothing

Set objCommand = Nothing

Set objConnection = Nothing

Set objRecordSet = Nothing


Open in new window

LVL 12

Expert Comment

Comment Utility
Thanks FIFBA!

Expert Comment

Comment Utility

Featured Post

Get up to 2TB FREE CLOUD per backup license!

An exclusive Black Friday offer just for Expert Exchange audience! Buy any of our top-rated backup solutions & get up to 2TB free cloud per system! Perform local & cloud backup in the same step, and restore instantly—anytime, anywhere. Grab this deal now before it disappears!

Join & Write a Comment

Introduction During my participation as a VBScript contributor at Experts Exchange, one of the most common questions I come across is this: "I have a script that runs against only one computer. How can I make it run against a list of computers in …
Learn about cloud computing and its benefits for small business owners.
It is a freely distributed piece of software for such tasks as photo retouching, image composition and image authoring. It works on many operating systems, in many languages.
Sending a Secure fax is easy with eFax Corporate ( First, Just open a new email message.  In the To field, type your recipient's fax number You can even send a secure international fax — just include t…

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now