VBScript: Find Active Directory Account Expiration Dates

Often it is useful to create a listing of when accounts in a Microsoft Active Directory organizational unit (OU) are set to expire. For example, if you plan to lower the time between forced password changes, it is good to know which accounts may be affected by the change. You can open the outputted file from our sample VBScript in Microsoft Excel or OpenOffice.org Calc and sort and recalculate dates based on the new maximum password age. Read further for the example code and output format...
The following code will create a tab separated file (flat file database) with the following fields for each line-record:
"Name" "Password Status" "Last Change" "Expiration Date"
'* Script Name: PasswordAge.vbs
'* Created On: 06/09/2009
'* Author: Michael C. Panagos
'* Website: http://www.grimadmin.com
'* Purpose: Outputs Microsoft Active Directory account
'* expiration dates to tab separated file.
'* Indicates whether accounts are Active or Expired.
'* History: Michael C. Panagos 06/09/2009
'* Initial Draft.
'* Legal: Copying and distribution of this code, with or without modification,
'* are permitted in any medium without royalty provided the copyright
'* notice and this notice are preserved. This code is offered as-is,
'* without any warranty.
'Account used to run script needs read access to Domain.
'Any standard Domain User account should work.
'Set the following variables
MyDomain = "MyDomain.org"
MyDN = "OU=Employees,DC=MyDomain,DC=org"
OutputFile = "C:\OutputFolder\AccOldPasswords.tab"
'Do not modify below this line
Const SEC_IN_DAY = 86400
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
Const ADS_SCOPE_SUBTREE = 2
Set objDomainNT = GetObject("WinNT://" & MyDomain)
intMaxPwdAge = objDomainNT.Get("MaxPasswordAge") / SEC_IN_DAY
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCOmmand.ActiveConnection = objConnection
objCommand.CommandText = _
"Select Name, distinguishedName from 'LDAP://" & MyDN & _
"' Where objectClass='user' AND objectClass <> 'computer'"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
On Error Resume Next
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFile=fso.GetFile(OutputFile)
If Err.Number = 0 Then
Set AFileStream = FSO.OpenTextFile(OutputFile,2)
Else
Set AFileStream = FSO.CreateTextFile(OutputFile,2)
End If
AFileStream.WriteLine "Name" & chr(09) & "Password Status" & chr(09) & "Last Change" & _
chr(09) & "Expiration Date"
Do Until objRecordSet.EOF
If (InStr(objRecordSet.Fields("Name").Value, "SystemMailbox") = 1) Then
objRecordSet.MoveNext
Else
ldapStr = "LDAP://" & objRecordSet.Fields("distinguishedName").Value
Set objUserLDAP = GetObject(ldapStr)
intCurrentValue = objUserLDAP.Get("userAccountControl")
If intCurrentValue and ADS_UF_DONT_EXPIRE_PASSWD Then
'Do nothing
Else
dtmValue = objUserLDAP.PasswordLastChanged
intTimeInterval = int(now - dtmValue)
If intTimeInterval >= intMaxPwdAge Then
PassExpStatus = "Expired"
Else
PassExpStatus = "Active"
End If
PassLastChangeDate = DateValue(dtmValue)
PassExpDate = DateValue(dtmValue + intMaxPwdAge)
AFileStream.WriteLine objRecordSet.Fields("Name").Value & chr(09) & PassExpStatus & _
chr(09) & PassLastChangeDate & chr(09) & PassExpDate
End If
objRecordSet.MoveNext
End If
Loop
AFileStream.Close
MsgBox "Done! (passwords expire after " & intMaxPwdAge & " days)"
Associate the .TAB file extension with your preferred spreadsheet application
Anonymous User