This VBS script will allow you to enter an Active Directory (AD) domain name and will return the following information to an Excel spreadsheet: Login Name, First Name, Last Name, Full Name, Description, Last Login and Password Last Changed information.
VBS Script:
strDomain = InputBox ("Enter Domain Name")
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Login Name"
objExcel.Cells(1, 2).Value = "First Name"
objExcel.Cells(1, 3).Value = "Last Name"
objExcel.Cells(1, 4).Value = "Full Name"
objExcel.Cells(1, 5).Value = "Description"
objExcel.Cells(1, 6).Value = "Last Login"
objExcel.Cells(1, 7).Value = "Password Last Changed"
On Error Resume Next
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = _
"Select ADsPath From 'LDAP://dc=" & strDomain & ",dc=com'" & _
" Where objectCategory='User' And userPrincipalName = '*'"
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
strPath = objRecordSet.Fields("ADsPath").Value
Set objUser = GetObject(strPath)
objExcel.Cells(intRow, 1).Value = objUser.sAMAccountName
objExcel.Cells(intRow, 2).Value = objUser.FirstName
objExcel.Cells(intRow, 3).Value = objUser.LastName
objExcel.Cells(intRow, 4).Value = objUser.FullName
objExcel.Cells(intRow, 5).Value = objUser.Description
objExcel.Cells(intRow, 6).Value = objUser.LastLogin
objExcel.Cells(intRow, 7).Value = objUser.PasswordLastChanged
objRecordSet.MoveNext
intRow = intRow + 1
Loop
objExcel.Range("A1:G1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
Set objRange = objExcel.Range("A2")
objRange.Sort objRange,1,,,,,,1
MsgBox "Done"
No Comments