Generating a report of user password expiration status

To start off, check out the setup section somewhat near the top. They should be fairly explanatory, with the only potentially tricky one being the “ouList” variable, which holds a list of Organization Units whose users you which to see in your report; it should be a tilde (“~”) delimited string. Some examples:

ou=contractors
ou=engineers,ou=contractors
ou=contractors~ou=engineers,ou=contractors

Compare example 1 and example 2; because the code is not meant to go into deeper levels, “ou=contractors” will only check for user objects at that particular level only. To include the nested OU “engineers”, it must be explicitly listed, such as in example 2.

The full sample is below:

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Description: Makes a CSV listing of password expiration status
' Author: C. Peter Chen, http://dev-notes.com
' Revision History:
'	1.0	20080318	Original concept written
'	1.0.1	20080319	Added column headings in the output
'				Added "excludeNoOu" switch to exclude objects 
'				  not in an Organizational Unit as a possible 
'				  way to exclude system objects like IWAM and 
'				  IUSR from output.
'	1.0.2	20080325	Added the "ouList" delimited string the 
'				  restriction of specific OUs to show up in 
'				  the report.
'				Added "debugMode" switch
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

option explicit
dim maxPwdAge, warningThreshold, ad, outputPath, outputFileName, keepDailyOutput, excludeNoOu, ouList, debugMode

''''''''''''''
' Some Setup '
''''''''''''''
maxPwdAge = 45			' What is the maximum age (in days) of passwords in your domain?
warningThreshold = 10		' The report will show warning (almost expired) status if expiration is within this many days.
ad = "dc=domain,dc=com"		' What is your domain? Example format: "dc=domainname,dc=com"
outputPath = "\\share\folder\"	' The path for the output CSV report with slash at the end; examples: "c:\", "c:\reports\", "\\fileshare\folder\"
outputFileName = "reportName"	' The file name of the output CSV report; no need for ".csv" at the end
keepDailyOutput = "N"		' Valid values include Y or N.  If Y, a new report will be created each time with file name format "filenameYYYY-MM-DD-HH24-MI.csv"; if N, each day's report will overwrite the previous day's as "filename.csv".
excludeNoOu = "Y"		' Valid values include Y or N.  If Y, objects not in an Organizational Unit will not appear in the report; it maybe a way to exclude system objects like IWAM and IUSR.

' ouList is a list of OUs, delimited by tilde ("~"), whose users will appear in the report
' Sample: "ou=sales,ou=fulltimers~ou=engineers,ou=contractors"
ouList = "ou=sales,ou=fulltimers~ou=engineers,ou=contractors"

debugMode = "N"			' If Y, any encountered errors will pop up on screen and a pop up will appear when the script completes

'''''''''''''
' End Setup '
'''''''''''''


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


'''''''''''''
' Constants '
'''''''''''''
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000

'''''''''''''
' Functions '
'''''''''''''
dim i, foundUser

function getAdObject (strUserFullName, ad, ouListArray)
	On Error Resume Next
	err.clear

	Set objUser = GetObject("LDAP://cn=" & strUserFullName & "," & ouListArray(0) & "," & ad)

	if err.number <> 0 then
		foundUser = "N"
		i = 1 ' Yes, start at the second one...
		do while i <= UBound(ouListArray)
			if err.number = -2147016656 then
				foundUser = "N"
				Set objUser = GetObject("LDAP://cn=" & strUserFullName & "," & ouListArray(i) & "," & ad)
			else
				foundUser = "Y"
				exit do
			end if
			i = i + 1
		loop
	else
		foundUser = "Y"
	end if
	
	if err.number <> 0 and foundUser = "Y" then
		exit function
	else
		getAdObject = objUser
		err.clear
		exit function
	end if
end function

'''''''''''''''''''''''''''''''
' The Main Part of the Script '
'''''''''''''''''''''''''''''''
dim fso, f, objConnection, objCommand, objRecordSet, intUAC, objUser, dtmValue, intTimeInterval

set fso = CreateObject("Scripting.FileSystemObject")

if keepDailyOutput="Y" then
	filedate=year(now) & "-" & month(now) & "-" & day(now) & "-" & hour(now) & "-" & minute(now)
	set f = fso.createtextfile(outputPath & outputFileName & filedate & ".csv")
else
	set f = fso.createtextfile(outputPath & outputFileName & ".csv")
end if

f.writeline("""User Name"",""Password Status"",""Password Age (Days)"",""LDAP Distinguished Name""")

Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
objCommand.CommandText = ";(objectCategory=User);userAccountControl,distinguishedName,name;subtree"
Set objRecordSet = objCommand.Execute

dim ouListArray
ouListArray = split(ouList,"~",-1,1)

Do Until objRecordset.EOF
	if (excludeNoOu = "Y" and instr(objRecordset.Fields("distinguishedName"),"OU=") = 0) then ' Do not show user not in an OU; this may exclude system users like IWAM and IUSR
		' Do nothing and skip this user
	else
		intUAC=objRecordset.Fields("userAccountControl")

		If intUAC AND ADS_UF_DONT_EXPIRE_PASSWD Then ' Password never expires for this user
			on error resume next
			
			set objUser = nothing
			getAdObject objRecordset.Fields("name"), ad, ouListArray

			dtmValue = objUser.PasswordLastChanged ' Just to test if error occurs
			
			if err.number = 0 then
				f.writeline("""" & objRecordset.Fields("name") & """,""never expire"","""",""" & objRecordset.Fields("distinguishedName") & """")
			else ' Error encountered...
				if debugMode = "Y" then
					msgbox(objRecordset.Fields("name") & "error. err.number='" & err.number & "', err.description='" & err.description & "'")
				else
					' Not in debug mode, so we suppress the error and do nothing
				end if
			end if
		else ' Password will expire for this user
			set objUser = nothing
			getAdObject objRecordset.Fields("name"), ad, ouListArray

			if not (objUser is nothing) then
				if objUser.AccountDisabled = false then ' show ENABLED users only
					on error resume next

					dtmValue = objUser.PasswordLastChanged 

					if err.number = 0 then
						intTimeInterval = int(now - dtmValue)
						if intTimeInterval >= maxPwdAge then
							f.writeline("""" & objRecordset.Fields("name") & """,""expired"","""& intTimeInterval & """,""" & objRecordset.Fields("distinguishedName") & """")
						elseif intTimeInterval >= (maxPwdAge - warningThreshold) then
							f.writeline("""" & objRecordset.Fields("name") & """,""expiring soon"","""& intTimeInterval & """,""" & objRecordset.Fields("distinguishedName") & """")				
						else
							f.writeline("""" & objRecordset.Fields("name") & """,""ok"","""& intTimeInterval & """,""" & objRecordset.Fields("distinguishedName") & """")
						end if
					else ' This user's password is set to force-change at next logon
						'if objUser.name <> "" then ' We still need to make sure this user is in the list of OUs we want to check
							f.writeline("""" & objRecordset.Fields("name") & """,""forced to change at next logon"","" "",""" & objRecordset.Fields("distinguishedName") & """")
						'end if
						err.clear
					end if
				else
					' Do nothing for DISABLED users
				end if
			else
				' Do nothing for users not found; probably in a different OU then specified.
			end if
		end if
	end if
	
	objRecordset.MoveNext
Loop
 
objConnection.Close

if debugMode = "Y" then
	msgbox("AD user password expiration script completed.  Report = " & outputPath & outputFileName & ".csv")
end if