Solved

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

Posted on 2006-11-15
10
1,048 Views
Last Modified: 2012-05-05
Hi!

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.
0
Comment
Question by:Stefan_Soderquist
  • 5
  • 4
10 Comments
 
LVL 67

Expert Comment

by:sirbounty
ID: 17946374
This should be what you're after...

'UserReport.vbs

Dim objFSO, strFileName, RptFile

Set objFSO = CreateObject("Scripting.FileSystemObject")
strFileName="C:\Output.txt"
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 "============================="
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
  .MoveFirst

  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
     RptFile.WriteLine
'Remove the next two lines (and this one) to display full report)
     x=x+1
     If x>=10 then wscript.quit
    .MoveNext
  Loop
  RptFile.Close
End With

' Clean up.
objCon.Close
Set objCon = Nothing
Set objCmd = Nothing
Set objRoot = Nothing
Set objRS = Nothing
Set RptFile = Nothing
Set objFSO = Nothing
0
 

Author Comment

by:Stefan_Soderquist
ID: 17946533
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;

OU1

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


OU2

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

and so on
0
 
LVL 67

Expert Comment

by:sirbounty
ID: 17947494
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?
0
 

Author Comment

by:Stefan_Soderquist
ID: 17949622
The first method would be perfect!
0
 
LVL 67

Expert Comment

by:sirbounty
ID: 17949646
Haha - too late, I considered it a challenge to enumerate all the OUs...just about done.  Will post something shortly...
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 67

Expert Comment

by:sirbounty
ID: 17949720
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!)
0
 

Author Comment

by:Stefan_Soderquist
ID: 17949812
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
0
 
LVL 67

Accepted Solution

by:
sirbounty earned 500 total points
ID: 17949984
Here ya go...

Dim objFSO, strFileName, RptFile

Set objFSO = CreateObject("Scripting.FileSystemObject")
strFileName="C:\Output.csv"
Set RptFile = objFSO.CreateTextFile(strFileName)

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

EnumOUs(objDomain.ADsPath)
RptFile.Close
Set RptFile=Nothing
Set objUsers=Nothing
Set objOUs=Nothing
Set objDomain=Nothing
Set objRoot=Nothing
Set objFSO=Nothing
wscript.quit

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)
    Next
End Sub

Sub EnumUsers(adspath)
    Dim objUsers, User
    Set objUsers = GetObject(adspath)
    objUsers.Filter = Array("User")
    RptFile.WriteLine
    For Each User In objUsers
        If User.sn <> "" and User.givenName <> "" Then
            RptFile.WriteLine User.sAMAccountName & ", " & User.givenName & ", " & User.sn
        End If
    Next
    RptFile.WriteLine
End Sub
0
 

Author Comment

by:Stefan_Soderquist
ID: 17959049
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=", "")

to

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

it solved my last problem

Many thanks to sirbounty for the fast response and a speedy solution
0
 
LVL 23

Expert Comment

by:gecko_au2003
ID: 17959069
handy info as well, thanks :)
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
using Access 8 59
using web browser with BING 40 111
How to Add / Edit Windows Menu 4 52
MS Access 03, TransferText, decimal places 8 47
Introduction I needed to skip over some file processing within a For...Next loop in some old production code and wished that VB (classic) had a statement that would drop down to the end of the current iteration, bypassing the statements that were c…
Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

862 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

25 Experts available now in Live!

Get 1:1 Help Now