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

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

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)   
    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
    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
        dtmValue = objUserLDAP.PasswordLastChanged
        intTimeInterval = int(now - dtmValue)

        If intTimeInterval >= intMaxPwdAge Then
            PassExpStatus = "Expired"
            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
End If
MsgBox "Done! (passwords expire after " & intMaxPwdAge & " days)"

Associate the .TAB file extension with your preferred spreadsheet application

Tag: vbscript microsoft active directory

Comments (1)

The Grim Admin