• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1059
  • Last Modified:

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.
  • 5
  • 4
1 Solution
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
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?
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

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
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
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
handy info as well, thanks :)

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 5
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now