VBScript to create a list of all users in AD and in what OU


I'm looking for a VBScript that export a list of all user accounts in an AD to a texfile. The list should include "User Logon Name", "First name", Last name" and in what OU it resides.
Who is Participating?
Here ya go...

Dim objFSO, strFileName, RptFile

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set RptFile = objFSO.CreateTextFile(strFileName)

Dim objRoot, objDomain
Set objRoot = GetObject("LDAP://RootDSE")
Set objDomain = GetObject("LDAP://" & objRoot.Get("defaultNamingContext"))

Set RptFile=Nothing
Set objUsers=Nothing
Set objOUs=Nothing
Set objDomain=Nothing
Set objRoot=Nothing
Set objFSO=Nothing

Sub EnumOUs(adspath)
    Dim objOUs, OU
    Set objOUs = GetObject(adspath)
    objOUs.Filter = Array("OrganizationalUnit")
    Call EnumUsers(objOUs.ADsPath)
    For Each OU In objOUs
        wscript.echo "Processing " & Replace(OU.Name, "OU=", "")
        RptFile.WriteLine Replace(Ucase(OU.Name), "OU=", "")
        Call EnumOUs(OU.ADsPath)
End Sub

Sub EnumUsers(adspath)
    Dim objUsers, User
    Set objUsers = GetObject(adspath)
    objUsers.Filter = Array("User")
    For Each User In objUsers
        If User.sn <> "" and User.givenName <> "" Then
            RptFile.WriteLine User.sAMAccountName & ", " & User.givenName & ", " & User.sn
        End If
End Sub
This should be what you're after...


Dim objFSO, strFileName, RptFile

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set RptFile = objFSO.CreateTextFile(strFileName)

Dim objCon, objCmd, objRoot, strDomain
Dim strFilter, strQuery, objRS
On Error Resume Next

Set objCon = CreateObject("ADODB.Connection")
Set objCmd = CreateObject("ADODB.Command")

objCon.Provider = "ADsDSOOBject"
objCon.Open "Active Directory Provider"

Set objCmd.ActiveConnection = objCon
Set objRoot = GetObject("LDAP://RootDSE")

'Get domain
strDomain = objRoot.Get("defaultNamingContext")
strBase = "<LDAP://" & strDomain & ">"
RptFile.WriteLine "Users in " & Replace(Replace(strDomain, "DC=",""), ",",".")
RptFile.WriteLine "============================="

'Define the filter elements
strFilter = "(&(objectCategory=person)(objectClass=user))"

'List all attributes you will require
strAttributes = "distinguishedName,sAMAccountName,givenName,sn,userPrincipalName"

'compose query
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
With objCmd
  .CommandText = strQuery
  .Properties("Page Size") = 99999
  .Properties("Timeout") = 300
  .Properties("Cache Results") = False
Set objRS = .Execute
End With

With objRS

  Do Until .EOF
     strData="DN: " & .Fields("distinguishedName") & vbCrLf & "GN: " & .Fields("givenName") & vbCrLf & "SN: " & .Fields("sn") & vbCrLf & _
                  "SAM: " & .Fields("sAMAccountName") & vbCrLf & "UPN: " & .Fields("userPrincipalName")
     RptFile.WriteLine strData
'Remove the next two lines (and this one) to display full report)
     If x>=10 then wscript.quit
End With

' Clean up.
Set objCon = Nothing
Set objCmd = Nothing
Set objRoot = Nothing
Set objRS = Nothing
Set RptFile = Nothing
Set objFSO = Nothing
Stefan_SoderquistAuthor Commented:
Hi Sirbounty!

I think i wasn't clear about the output and formatting on the textfile.
I need a textfile that list all users (one line per user with logon name, first name and last name) and is grouped by OU so I can later import it to Excel to make a report that shows the user accounts grouped by OU.

Let me show you what I mean;


Login name1, First name, Last name
Login name2, First name, Last name


Login name3, First name, Last name
Login name4, First name, Last name

and so on
Cloud Class® Course: Microsoft Office 2010

This course will introduce you to the interfaces and features of Microsoft Office 2010 Word, Excel, PowerPoint, Outlook, and Access. You will learn about the features that are shared between all products in the Office suite, as well as the new features that are product specific.

Hmm - that complicates things then.
I can see two immediate methods for this, one doable since I have some model code, the other maybe/maybe not - would work in theory and take some testing.

The first would appear in the format:

[OU Name]
User Login, gn, sn

Would that suffice?
Stefan_SoderquistAuthor Commented:
The first method would be perfect!
Haha - too late, I considered it a challenge to enumerate all the OUs...just about done.  Will post something shortly...
One last question...do you want to know what's being done, while it's being done, or would you rather just stare at an empty screen until it's complete?

Iow - we can have it state:
Processing...please wait (until it's done)

or I can iterate each OU as it's being queried along the way, so that you know the current status (I don't know how large your AD is - mine this would be a benefit with over 40k users!)
Stefan_SoderquistAuthor Commented:
If it isn't to much job for you, include the progress bar to indicate which OU the script is processing. Otherwise it's just OK with a simple progress bar
Stefan_SoderquistAuthor Commented:
The script works like I first wanted. Later I realised when I executed the script, I needed a path added to the OU because i have multiple OU with the same name and I needed a way to differentiate them. I found out that if I changed one line in the Sub EnumOUs section;

RptFile.WriteLine Replace(Ucase(OU.Name), "OU=", "")


RptFile.WriteLine Replace(Ucase(OU.distinguishedName), "OU=", "")

it solved my last problem

Many thanks to sirbounty for the fast response and a speedy solution
Shane Russell2nd Line Desktop SupportCommented:
handy info as well, thanks :)
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.