Spread the love
Option Explicit
' **********************************************************************************
' *
' * Title:              Export user from AD to csv file
' *
' * File Name:          ExportUserstoCSV.vbs
' * Programmer(s):      Stephen Wireman
' *
' * First Written:      04/11/2017
' * Last Modified: 	
' *
' * Version:            1.0.0
' *
' * Purpose:            To extract user account
' *                     information from Active Directory
' *                     and write it to a CSV file.
' *
' * Information:        Requires read permissions in Active Directory
' *                     for all queried objects
' *
' * Notes:              To exclude disabled accounts
' *                     add (userAccountControl=" & ADS_UF_ACCOUNTDISABLE & "))"
' *                     to the variable "varFilter"
' **********************************************************************************

' ***********************************************************
' * Define script constants                                 *
' ***********************************************************
Const ADS_UF_ACCOUNTDISABLE = &H2
Const ForWriting            = 2

' ***********************************************************
' * Define variable dimensions, assign variables to objects *
' ***********************************************************
Dim adoCommand     : Set adoCommand    = CreateObject("ADODB.Command")
Dim adoConnection  : Set adoConnection = CreateObject("ADODB.Connection")
Dim varBaseDN      : varBaseDN         = vbNullString
Dim varFilter      : varFilter         = "(&(objectCategory=person)(objectClass=user))"
Dim varAttributes  : varAttributes     = "name,samaccountname,distinguishedname,mail"
Dim objRootDSE     : Set objRootDSE    = Nothing
Dim varDNSDomain   : varDNSDomain      = vbNullString
Dim strQuery       : strQuery          = vbNullString
Dim adoRecordset   : Set adoRecordset  = Nothing
Dim objFSO         : Set objFSO        = CreateObject("Scripting.FileSystemObject")
Dim objCSVFile
Dim intUAC

' ***********************************************************
' * Execution phase                                         *
' ***********************************************************
Call Main()
Call Finish()

' ***********************************************************
' * Functions and Sub Routines                              *
' ***********************************************************
Sub Main()
	' Setup ADO connection.
	adoConnection.Provider = "ADsDSOObject"
	adoConnection.Open "Active Directory Provider"
	Set adoCommand.ActiveConnection = adoConnection
	 
	' Set the root of the search at the root of the domain.
	Set objRootDSE = GetObject("LDAP://RootDSE")
	 
	varDNSDomain = objRootDSE.Get("defaultNamingContext")
	varBaseDN = "<LDAP://" &amp; varDNSDomain &amp; ">"
	 
	' Construct the LDAP syntax query.
	strQuery = varBaseDN &amp; ";" &amp; varFilter &amp; ";" &amp; varAttributes &amp; ";subtree"
	adoCommand.CommandText = strQuery
	adoCommand.Properties("Page Size") = 1000
	adoCommand.Properties("Timeout") = 20
	adoCommand.Properties("Cache Results") = False
	 
	' Execute the query.
	Set adoRecordset = adoCommand.Execute
	 
	Set objCSVFile = objFSO.CreateTextFile(".\ADUsers.csv", ForWriting, True)
	 
	' Write selected AD Attributes as CSV columns(first line)
	objCSVFile.Write replace(varAttributes, ",", vbtab)
	 
	objCSVFile.Writeline ' New Line
	 
	' Enumerate the resulting recordset.
	Do Until adoRecordset.EOF
	 
		' Retrieve values and write into CSV file.
		objCSVFile.Write adoRecordset.Fields("name").Value &amp; vbtab
		objCSVFile.Write adoRecordset.Fields("samaccountname").Value &amp; vbtab
		objCSVFile.Write adoRecordset.Fields("distinguishedname").Value &amp; vbtab
		objCSVFile.Write adoRecordset.Fields("mail").Value &amp; vbtab
		objCSVFile.Writeline  ' New Line

		' Move to the next record in the recordset.
		adoRecordset.MoveNext
	Loop
	 
	 objCSVFile.Close
	 
	' close ado connections.
	adoRecordset.Close
	adoConnection.Close
	
	Set objCSVFile   = Nothing
	Set adoRecordset = Nothing
	Set objRootDSE   = Nothing	
End Sub

Sub Finish()
	Set adoConnection = Nothing
	Set adoCommand    = Nothing
	
	If err then 
		Call wscript.echo("Error occured during processing:" &amp; vbcrlf &amp; vbcrlf &amp; _
		                   err.number &amp; "," &amp; err.description &amp; "," &amp; err.source)
		Call wscript.quit(err.number)
	Else
		Call wscript.quit(0)
	End If
End Sub

Leave a Comment

Your email address will not be published. Required fields are marked *