Gathering password change dates

This came about when my IT staff was tasked with preparing the company for mandatory password changes forced by Group Policy. We wanted to give everyone a chance to change their password once before the GPO locked them out of their accounts. For several weeks I had to gather all the password information to see who we needed to talk to.

I also wanted a distributable report, so I read up on populating Excel spreadsheets from the Microsoft Script Center website (see my links section). I included some pretty-print features like autoformatting the column widths, making the column headings bold, and performing a sort on the data.

The script has duplicate sections to pull data out of different OUs. You can add or remove as many of this section as desired. Just change the LDAP section to point to the appropriate place in your AD forest.

Copy and paste the following into a file named PASSWORDDATES.VBS then edit.

'* This script creates an Excel spreadsheet showing users and
'* their last password change date. Running this script assumes
'* you have MS-Excel loaded on the workstation.
'* - Dean T. Uemura

'* Execute the script by typing:
'* CSCRIPT PASSWORDDATES.VBS at a command line prompt
'* PasswordFile holds the name of the spreadsheet and
'* will be saved in My Documents

Const PasswordFile = "passwords.xls"
set objFSO = CreateObject("Scripting.FileSystemObject")
set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Add

'* Establish Header Row - make them 12-point bold print
objExcel.Cells(1,1).Value = "User"
objExcel.Cells(1,2).Value = "Location"
objExcel.Cells(1,3).Value = "Password Date"
set objRange = objExcel.Range("A1:C1")
objRange.Font.Size = 12
objRange.Font.Bold = TRUE

iWriteRow = 1
on error resume next

'* Each user OU is done separately in this script
wscript.echo "OU1"
set objOU = GetObject("LDAP://ou=OU1,dc=mydomain,dc=com")
objOU.Filter = Array("user")
for each objUser in objOU
iwriteRow = iwriteRow + 1
'* wscript.echo objuser.name
dtmValue = objUser.PasswordLastChanged
objExcel.Cells(iWriteRow,1).Value = objUser.Name
objExcel.Cells(iWriteRow,2).Value = "OU1"
objExcel.Cells(iWriteRow,3).Value = dtmValue
next

wscript.echo "OU2"
set objOU = GetObject("LDAP://ou=OU2,dc=mydomain,dc=com")
objOU.Filter = Array("user")
for each objUser in objOU
iwriteRow = iwriteRow + 1
'* wscript.echo objuser.name
dtmValue = objUser.PasswordLastChanged
objExcel.Cells(iWriteRow,1).Value = objUser.Name
objExcel.Cells(iWriteRow,2).Value = "OU2"
objExcel.Cells(iWriteRow,3).Value = dtmValue
next

'* Autofit the column widths
set objRange = objExcel.Range("A1")
objRange.activate
set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()
set objRange = objExcel.Range("B1")
objRange.activate
set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()
set objRange = objExcel.Range("C1")
objRange.activate
set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()

'* Sort by Location then Dateset
objRange = objExcel.Range("A1").SpecialCells(11)
set objRange2 = objExcel.Range("B1")
set objRange3 = objExcel.Range("C1")
objRange.Sort objRange2,,objRange3,,,,,1

'* Save the Spreadsheet file
set objWorkbook = objExcel.ActiveWorkbook
objWorkbook.SaveAs(PasswordFile)
objExcel.Quit