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