VBScript: Find Active Directory Account Expiration Dates

Scripts & Tools

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

Tag: vbscript microsoft active directory

Share It!

Story Options

  • VBScript: Find Active Directory Account Expiration Dates
  • 1 comments
Do you know why I love Alexander McQueen? I suppose it shouldn't be too difficult to figure out the hermes replica bags. Here we have a designer that is very well-known, with several iconic pieces that are recognizable despite the many different renditions year after year. At the same time though, creative director Sarah Burton is not afraid to experiment with new designer replica handbags . It is definitely something I appreciate and it makes me love this designer even more. So, of course, I was intrigued when I saw the Alexander McQueen Cage Croc Embossed Leather Shoulder cheap replica handbags. Okay, so this style isn't exactly brand new. But it caught my eye because it is one of those styles that is a little bit different for Alexander McQueen. It is similar to other box clutches, which this designer is known for, but it is different too. Rather than having rounded edges, this one has very clean, hard lines. And, unlike other styles, this piece has a simple push closure and an optional leather shoulder strap. I really like the decorative metal straps too. They remind me of vintage luggage a little bit. There is no doubt this clutch would look great with semi-formal and formal looks. For some reason, I keep envisioning it paired with a vintage-inspired black dress and mulberry replica bags.