VB Script Needed to extract user information from active directory

I am needing to gain a list of users where their Department equals something specific.  For example if Department = Merchandising I need a csv file that contains the users:

first name,last name,username,email address

It would be nice if when the script is executed it would pop up a window asking for the department name to query.
LVL 4
seaninmanAsked:
Who is Participating?
 
jawa29Connect With a Mentor Commented:
Hi seaninman

This should do what your asking.

Jawa29


Const ForWriting = 2

Set oRoot = GetObject("LDAP://RootDSE")
vDomain = oRoot.Get("DefaultNamingContext") 

vDepartment = InputBox("Department","Department","Enter Department")

Set oConnection = CreateObject("ADODB.Connection")
Set oCommand =   CreateObject("ADODB.Command")
oConnection.Provider = "ADsDSOObject"
oConnection.Open "Active Directory Provider"
Set oCommand.ActiveConnection = oConnection
oCommand.Properties("Page Size") = 1000

oCommand.CommandText = "<LDAP://" & vDomain & ">;(&(!userAccountControl:1.2.840.113556.1.4.803:=65536)((objectCategory=Person)(department=" & vDepartment & ")));" &_
	"givenName, sn, mail, samAccountName,;Subtree"
Set oRS = oCommand.Execute

sTxt = "Firstname,Surname,Logon,Email" & vbCrLf
Do While Not oRS.EOF
	sTxt = sTxt & oRS("givenName") & "," & oRS("sn") & "," & oRS("mail") & "," & oRS("samAccountName") & vbCrLf
	oRS.MoveNext
Loop

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oTextFile = oFSO.OpenTextFile("c:\UserExport.txt", ForWriting, True)
oTextFile.WriteLine(sTxt)
oTextFile.Close

Open in new window

0
 
prashanthdCommented:
Try the following code....


On Error Resume Next

dpname="" 'mention departname to check
outputfile="C:\output.csv"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(outputfile, 2)


Dim objRootDSE, strDomain, strUsername, objConnection, objCommand, objRecordSet, strDN

' Get domain components
Set objRootDSE = GetObject("LDAP://RootDSE")
strDomain = objRootDSE.Get("DefaultNamingContext")

' Set ADO connection
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

' Set ADO command
Set objCommand = CreateObject("ADODB.Command")
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

objCommand.CommandText = "SELECT givenName,sn,mail,samaccountname FROM 'LDAP://" & strDomain & "' WHERE objectCategory='person' and department='"& dpname &"'"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 30
objCommand.Properties("Cache Results") = False
' Set recordset to hold the query result
Set objRecordSet = objCommand.Execute

objTextFile.WriteLine "First Name,Last Name, AccountName, Mail"

Do While Not objRecordSet.EOF
   
    strfName = objGroup.Get("givenName")
    strlName = objGroup.Get("sn")
    strmail = objGroup.Get("mail")
    strSAMAccountName = objGroup.Get("sAMAccountName")
   
    objTextFile.WriteLine strfName &","& strlName &","& strSAMAccountName &","& strmail
   
    objRecordSet.MoveNext
Loop

objTextFile.Close

WScript.Echo "Done, Check output file"
0
 
prashanthdCommented:
hmmm...some errors in my earlier code, you can try this
'On Error Resume Next

dpname="IEMC" 'mention departname to check
outputfile="C:\output.csv"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.createTextFile(outputfile, 2)

Const ADS_SCOPE_SUBTREE = 2

Dim objRootDSE, strDomain, strUsername, objConnection, objCommand, objRecordSet, strDN

' Get domain components
Set objRootDSE = GetObject("LDAP://RootDSE")
strDomain = objRootDSE.Get("DefaultNamingContext")

' Set ADO connection
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

' Set ADO command
Set objCommand = CreateObject("ADODB.Command")
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

objCommand.CommandText = "SELECT givenName,sn,mail,samaccountname FROM 'LDAP://" & strDomain & "' WHERE 

objectCategory='person' and department='"& dpname &"'"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 30
objCommand.Properties("Cache Results") = False
' Set recordset to hold the query result
Set objRecordSet = objCommand.Execute

objTextFile.WriteLine "First Name,Last Name, AccountName, Mail"

Do While Not objRecordSet.EOF 
    
    strfName = objRecordSet.Fields("givenName").Value
    strlName = objRecordSet.Fields("sn").Value
    strmail = objRecordSet.Fields("mail").Value
    strSAMAccountName = objRecordSet.Fields("sAMAccountName").Value
    
    objTextFile.WriteLine strfName &","& strlName &","& strSAMAccountName &","& strmail
wscript.echo strfName &","& strlName &","& strSAMAccountName &","& strmail
    
    objRecordSet.MoveNext
Loop

objTextFile.Close

WScript.Echo "Done, Check output file"

Open in new window

0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.