How can I use a script to determine password-expiration dates for users in a domain or an organizational unit (OU) and send an email message to accounts whose passwords expire soon?

A. I recently had a client whose users had Active Directory (AD) accounts only for Microsoft Outlook Web Access (OWA); users would never actually log on by using the AD account. Although OWA notifies users that their passwords expire soon, the company wants users to receive an email message letting them know that the account is due to expire.

I wrote the following script, reportpasswordchange.vbs, which you can download at http://www.windowsitpro.com/articles/download/rptpaswdchange.zip, that searches every container and OU for users in the savilltech.com domain and for the number of days that passwords last (your maximum password age). You'll need to enter the root container to search (e.g., dc=savilltech,dc=com), and you'll need to change the sender address and possibly also the subject and message text in the script's SendEmailMessage subroutine. The script expects to run on a server running Microsoft IIS and SMTP, but you can modify this. Doing so would require rewriting parts of the script and is beyond the scope of this Q&A. Save the script as reportpasswordchange.vbs and execute it via CScript. (Because of space limitations, some lines in the script wrap to two lines, so to avoid runtime errors, run the downloaded version.)

'
' John Savill 8th June 2005
' Runs check on last password change date.
'
Option Explicit

Dim objCommand, objConnection, objChild, objUserConnection, strBase, _
  strFilter, strAttributes, strPasswordChangeDate, intPassAge
Dim lngTZBias, objPwdLastSet, strEmailAddress, objMessage
Dim objShell, lngBiasKey, k, PasswordExpiry, strRootDomain
Dim strQuery, objRecordset, strName, strCN

' ********** CHANGE THESE VALUES TO PASSWORD EXPIRY AND ROOT OF
' DIRECTORY WHERE USERS WILL BE SEARCHED ***********

PasswordExpiry=35
strRootDomain="dc=savilltech,dc=com"

' **************************************************************
' **************************************************************

' Obtain local Time Zone bias from machine registry.
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = _
objShell.RegRead("HKLM\System\CurrentControlSet\Control\" & _
  "TimeZoneInformation\ActiveTimeBias")
If UCase(TypeName(lngBiasKey)) = "LONG" Then
  lngTZBias = lngBiasKey
ElseIf UCase(TypeName(lngBiasKey)) = "VARIANT()" Then
  lngTZBias = 0
  For k = 0 To UBound(lngBiasKey)
    lngTZBias = lngTZBias + (lngBiasKey(k) * 256^k)
  Next
End If

Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
strBase = ""

strFilter = "(&(objectCategory=person)(objectClass=user))"
strAttributes = "sAMAccountName,cn,mail,pwdLastSet,distinguishedName"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 100
objCommand.Properties("Timeout") = 30
objCommand.Properties("Cache Results") = False
Set objRecordSet = objCommand.Execute

' WScript.echo "Running at " & Date()

Do Until objRecordSet.EOF
  strName = objRecordSet.Fields("sAMAccountName").Value
  strCN = objRecordSet.Fields("cn").value
  strEmailAddress = objRecordSet.Fields("mail").value
  Wscript.Echo "NT Name: " & strName & ", Common Name: " & strCN

  Set objUserConnection = GetObject("LDAP://" & _
    objRecordSet.Fields("distinguishedName").Value)
  Set objPwdLastSet = objUserConnection.pwdLastSet
  strPasswordChangeDate = Integer8Date(objPwdLastSet, lngTZBias)
  WScript.Echo vbTab & "Password last changed at " & _
    strPasswordChangeDate
  intPassAge = DateDiff("d", strPasswordChangeDate, Now)
  WScript.Echo vbTab & "Password changed " & intPassAge & " days ago"

  If intPassAge = (PasswordExpiry-3) Then
    WScript.echo vbTab & "Sending user notification to " & _
      strEmailAddress & " that password expires in 3 days"
  Call SendEmailMessage(strEmailAddress, 3)
  ElseIf intPassAge = (PasswordExpiry-6) Then
    WScript.echo vbTab & "Sending user notification to " & _
      strEmailAddress & " that password expires in 6 days"
    Call SendEmailMessage(strEmailAddress, 6)
  ElseIf intPassAge = (PasswordExpiry-9) Then
    WScript.echo vbTab & "Sending user notification to " & _
      strEmailAddress & " that password expires in 9 days"
    Call SendEmailMessage(strEmailAddress, 9)
  End If

  objRecordSet.MoveNext
Loop

objConnection.Close


Function Integer8Date(objDate, lngBias)
' Function to convert Integer8 (64-bit) value to a date, adjusted for
' local time zone bias.
  Dim lngAdjust, lngDate, lngHigh, lngLow
  lngAdjust = lngBias
  lngHigh = objDate.HighPart
  lngLow = objdate.LowPart
  ' Account for the error in IADslargeInteger property methods.
  If lngLow < 0 Then
    lngHigh = lngHigh + 1
  End If
  If (lngHigh = 0) And (lngLow = 0) Then
    lngAdjust = 0
  End If
  lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
    + lngLow) / 600000000 - lngAdjust) / 1440
' Trap error if lngDate is overly large.
  On Error Resume Next
  Integer8Date = CDate(lngDate)
  If Err.Number < > 0 Then
    On Error GoTo 0
    Integer8Date = #1/1/1601#
  End If
  On Error GoTo 0
End Function

Sub SendEmailMessage(strDestEmail, strNoOfDays)
  Set objMessage = CreateObject("CDO.Message")
  objMessage.Subject = "Password Expires in " & strNoOfDays & " days"
  objMessage.Sender = "administrator@savilltech.com"
  objMessage.To = strDestEmail
  objMessage.TextBody = "Your password expires in " & strNoOfDays & " _
    days. Please goto http://changepass.com and reset" objMessage.Send
End Sub

reportpasswordchange.vbs

Microsoft (R) Windows Script Host Version 5.6
Copyright (C) Microsoft Corporation 1996-2001. All rights reserved.

NT Name: bwayne, Common Name: Bruce Wayne
Password last changed at 5/7/2005 8:59:01 PM
Password changed 39 days ago
NT Name: CKent, Common Name: Clark Kent
Password last changed at 5/7/2005 9:01:32 PM
Password changed 39 days ago
NT Name: wwest, Common Name: Wally West
Password last changed at 6/8/2005 7:55:47 PM
Password changed 7 days ago
NT Name: krayner, Common Name: Kyle Rayner
Password last changed at 5/7/2005 9:19:52 PM
Password changed 39 days ago