Or, for free - this script was started by Richard Mueller, and I added a LOT
to it. This will create a spreadsheet with a lot of information for you. We
use it to document out OU structure, and check out consistencies of use.
This starts at a defined OU, and creates tabs for each OU under that that
contains users.
To use:
In line 31, change the file save locatioon and name to where and what you
want
In line 36 and 37, change the numbers of spreadsheets to fit your need - if
you don't need nore than 3, comment out 35- 40
In 41, set for the domain, and starting OU
Save, and run.
Any questions, feel free to ask he.re
--------------CreateUserListExcel.vbs-------------------------
' CreateUserList3.vbs
' VBScript program to create a Microsoft Excel spreadsheet documenting
' all users in the domain.
'
' ----------------------------------------------------------------------
' Copyright (c) 2002 Richard L. Mueller
' Version 1.0 - November 12, 2002
' Version 1.1 - February 19, 2003 - Standardize Hungarian notation.
' This program enumerates all users in the domain and writes each user's
' LDAP DistinguishedName to a Microsoft Excel spreadsheet.
'
' You have a royalty-free right to use, modify, reproduce, and
' distribute this script file in any way you find useful, provided that
' you agree that the copyright owner above has no warranty, obligations,
' or liability for such use.
' Rewritten by Randy Reimers to add fields and save to Excel
'Option Explicit
Dim strExcelPath, oDomain, oContainer, usr, usrDN
Dim objRecordSet, strDN, objExcel, objSheet, oObj, sClass, subPath, NTDomain
Dim intIndex, k, sheet, strSheet, objWorkBook, i, objConnection, objCommand
Dim strFilter, strValue, strQuery
k = 2
sheet = 1
strFilter = "(&(objectCategory=person)(objectClass=user))"
strValue = ";DistinguishedName,Name"
' Spreadsheet file to be created.
strExcelPath = "F:\UserListWG.xls"
' Bind to Excel object.
Set objExcel = CreateObject("Excel.Application")
Set objWorkBook = objExcel.Workbooks.Add 'new
If objWorkBook.Sheets.Count < 18 then
For i = objWorkBook.Sheets.Count to 20
objWorkBook.Sheets.Add()
Next
End if
Set oDomain = GetObject("LDAP://OU=WG,dc=corp,dc=inet")
' Use ADO to search the domain for all users.
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOOBject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
EnumOU(oDomain)
' Save the spreadsheet.
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close
' Quit Excel.
objExcel.Application.Quit
' Clean up.
Set objRecordSet = Nothing
Set objSheet = Nothing
Set objExcel = Nothing
MsgBox "Done"
Wscript.Quit
Function EnumOU(oContainer)
For Each oObj In oContainer
For Each sClass in oObj.ObjectClass
If LCase(sClass) = "organizationalunit" Then
subPath=oObj.AdsPath
' wscript.echo subPath
Call newSheet(subPath, sheet)
EnumOUT(subPath)
sheet = sheet + 1
If k = 2 Then
sheet = sheet - 1
End If
k = 2
End If
Next
Next
End Function
Function EnumOUT(oContainer)
strQuery = "<" & oContainer & ">;" & strFilter & strValue & ";subtree"
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 500
objCommand.Properties("Timeout") = 30
objCommand.Properties("Cache Results") = False
objCommand.Properties("Sort on") = "Name"
Set objRecordSet = objCommand.Execute
Do Until objRecordSet.EOF
usrDN = ""
On Error Resume Next
usrDN = objRecordSet.Fields("distinguishedName")
Set objItem = GetObject("LDAP://" & usrDN)
intIndex = InStr(usrDN, "OU=")
usrDN = Mid(usrDN, intIndex)
'objSheet.Cells(k, 1).Value = objRecordSet.Fields("name")
objSheet.Cells(k, 1).Value = objItem.cn
objSheet.Cells(k, 2).Value = objItem.sAMAccountName
objSheet.Cells(k, 3).Value = objItem.ScriptPath
objSheet.Cells(k, 4).Value = usrDN
objSheet.Cells(k, 5).Value = objItem.Description
objSheet.Cells(k, 6).Value = objItem.WhenChanged
objSheet.Cells(k, 7).Value = objItem.WhenCreated
If objItem.TerminalServicesProfilePath <> "" Then
objSheet.Cells(k, 8).Value = objItem.TerminalServicesProfilePath
objSheet.Cells(k, 9).Value = objItem.TerminalServicesHomeDrive & " = " &
objItem.TerminalServicesHomeDirectory
End If
objSheet.Cells(k, 10).Value = objItem.PhysicalDeliveryOfficeName
objSheet.Cells(k, 11).Value = objItem.StreetAddress
objSheet.Cells(k, 12).Value = objItem.L
objSheet.Cells(k, 13).Value = objItem.St
objSheet.Cells(k, 14).Value = objItem.PostalCode
objSheet.Cells(k, 15).Value = objItem.TelephoneNumber
objSheet.Cells(k, 16).Value = objItem.Title
objSheet.Cells(k, 17).Value = objItem.Department
objSheet.Cells(k, 18).Value = objItem.Company
k = k + 1
objRecordSet.MoveNext
Loop
End Function
' Enumerate all users. Write each user's information to the
' spreadsheet.
Function newSheet(subPath, sheet)
strSheet = Mid(subPath,11)
intIndex = InStr(strSheet, "OU=")
strSheet = Left(strSheet, intIndex - 2)
' Bind to worksheet.
'wscript.Echo sheet & " " & strSheet
Set objSheet = objExcel.ActiveWorkbook.Worksheets(sheet)
objSheet.Name = strSheet
objSheet.Cells(1, 1).Value = "User Distinguished Name"
objSheet.Cells(1, 2).Value = "Logon ID"
objSheet.Cells(1, 3).Value = "Logon Script"
objSheet.Cells(1, 4).Value = "User's OU"
objSheet.Cells(1, 5).Value = "Description"
objSheet.Cells(1, 6).Value = "Changed"
objSheet.Cells(1, 7).Value = "Created"
objSheet.Cells(1, 8).Value = "TS Profile Path"
objSheet.Cells(1, 9).Value = "TS Home Path"
objSheet.Cells(1, 10).Value = "Office"
objSheet.Cells(1, 11).Value = "Street"
objSheet.Cells(1, 12).Value = "City"
objSheet.Cells(1, 13).Value = "State"
objSheet.Cells(1, 14).Value = "ZIP"
objSheet.Cells(1, 15).Value = "Phone"
objSheet.Cells(1, 16).Value = "Title"
objSheet.Cells(1, 17).Value = "Department"
objSheet.Cells(1, 18).Value = "Company"
' Format the spreadsheet.
objSheet.Range("A1
1").Font.Bold = True
objSheet.Select
objSheet.Range("A2").Select
objExcel.ActiveWindow.FreezePanes = True
objExcel.Columns(1).ColumnWidth = 45
objExcel.Columns(2).ColumnWidth = 26
objExcel.Columns(3).ColumnWidth = 15
objExcel.Columns(4).ColumnWidth = 65
objExcel.Columns(5).ColumnWidth = 20
objExcel.Columns(6).ColumnWidth = 15
objExcel.Columns(7).ColumnWidth = 15
objExcel.Columns(8).ColumnWidth = 30
objExcel.Columns(9).ColumnWidth = 25
objExcel.Columns(10).ColumnWidth = 20
objExcel.Columns(11).ColumnWidth = 25
objExcel.Columns(12).ColumnWidth = 15
objExcel.Columns(15).ColumnWidth = 15
objExcel.Columns(16).ColumnWidth = 25
objExcel.Columns(17).ColumnWidth = 20
objExcel.Columns(18).ColumnWidth = 20
End Function
'These are not used as of yet
Function makedate(dateval)
stryr = Left(dateval,4)
strmo = Mid(dateval,5,2)
strday = Right(dateval,2)
MakeDate = strmo & "/" & strday & "/" & stryr
End Function
Function MakeTime(timeval)
MakeTime = Left(TimeVal,2) & ":" & Right(TimeVal,2)
End Function
--------------CreateUserListExcel.vbs-------------------------end