Sending an e-mail to users whose password is about to expire

Originally published September 13, 2005

(Note November 13, 2007: My second most popular blog post ever. Also due for some cleanup and re-write.)

 

This has come up a number of times, and I actually thought I'd blogged about it in the past -- but I guess not.

If you have users that only use POP and/or IMAP, and never log into via Outlook/Exchange or OWA Premium, then those users do not get notified when their password is about to expire.

You can write a script that sends your users e-mail when their passwords are about to expire. The script below is based on a Scripting Clinic article available here, with some bug fixes and enhancements.

This script, with a few changes and enhancements, is also in my upcoming book from O'Reilly: “Essential Exchange Server 2003“.

'
' exch-pwd-expires.vbs
'
' Michael B. Smith
' March 21, 2005
'
' This program scans all users in the Users container and all organizational units
' beneath the HOSTING_OU organizational unit, for users whose passwords have either
' already expired or will expire within DAYS_FOR_EMAIL days.
'
' An email is sent, using CDO, via the SMTP server specified as SMTP_SERVER to the
' user to tell them to change their password. You should change strFrom to match
' the email address of the administrator responsible for password changes.
'
' You will, at a minimum, need to change the SMTP_SERVER, the HOSTING_OU, and the
' STRFROM constants. If you run this on an Exchange server, then SMTP_SERVER can
' be "127.0.0.1" - and it may be either an ip address or a resolvable name.
'
' If you don't have an OU containing sub-OU's to scan, then set HOSTING_OU to the
' empty string ("").
'

 Option Explicit

 ' Per environment constants - you should change these!
 Const HOSTING_OU  = "Hosting"
 Const SMTP_SERVER  = "127.0.0.1"
 Const STRFROM   = "emailadmin@your.domain"
 Const DAYS_FOR_EMAIL  = 15

 ' System Constants - do not change
 Const ONE_HUNDRED_NANOSECOND    = .000000100   ' .000000100 is equal to 10^-7
 Const SECONDS_IN_DAY            = 86400
 Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
 Const E_ADS_PROPERTY_NOT_FOUND  = &h8000500D

 ' Change to "True" for extensive debugging output
 Const bDebug   = False

 Dim objRoot
 Dim numDays, iResult
 Dim strDomainDN
 Dim objContainer, objSub

 Set objRoot = GetObject ("LDAP://RootDSE")
 strDomainDN = objRoot.Get ("defaultNamingContext")
 Set objRoot = Nothing

 numdays = GetMaximumPasswordAge (strDomainDN)
 dp "Maximum Password Age: " & numDays

 If numDays > 0 Then

  Set objContainer = GetObject ("LDAP://CN=Users," & strDomainDN)
  Call ProcessFolder (objContainer, numDays)
  Set objContainer = Nothing

  If Len (HOSTING_OU) > 0 Then
   Set objContainer = GetObject ("LDAP://OU=" & HOSTING_OU & "," & strDomainDN)

   For each objSub in objContainer
    Call ProcessFolder (objSub, numDays)
   Next

   Set objContainer = Nothing
  End If

  '========================================
  ' Add the number of days to the last time
  ' the password was set.
  '========================================
  'whenPasswordExpires = DateAdd ("d", numDays, oUser.PasswordLastChanged)

  'WScript.Echo "Password Last Changed: " & oUser.PasswordLastChanged
  'WScript.Echo "Password Expires On: " & whenPasswordExpires
 End If

 WScript.Echo "Done"

Function GetMaximumPasswordAge (ByVal strDomainDN)
 Dim objDomain, objMaxPwdAge
 Dim dblMaxPwdNano, dblMaxPwdSecs, dblMaxPwdDays

 Set objDomain = GetObject("LDAP://" & strDomainDN)
 Set objMaxPWdAge = objDomain.maxPwdAge

 If objMaxPwdAge.LowPart = 0 And objMaxPwdAge.Highpart = 0 Then
  ' Maximum password age is set to 0 in the domain
  ' Therefore, passwords do not expire
  GetMaximumPasswordAge = 0
 Else
  dblMaxPwdNano = Abs (objMaxPwdAge.HighPart * 2^32 + objMaxPwdAge.LowPart)
  dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND
  dblMaxPwdDays = Int (dblMaxPwdSecs / SECONDS_IN_DAY)
  GetMaximumPasswordAge = dblMaxPwdDays
 End If
End Function

Function UserIsExpired (objUser, iMaxAge, iDaysForEmail, iRes)
 Dim intUserAccountControl, dtmValue, intTimeInterval
 Dim strName

 On Error Resume Next
 Err.Clear

 strName = Mid (objUser.Name, 4)
 intUserAccountControl = objUser.Get ("userAccountControl")

 If intUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then
  dp "The password for " & strName & " does not expire."
  UserIsExpired = False
 Else
  iRes = 0
  dtmValue = objUser.PasswordLastChanged
  If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
   UserIsExpired = True
   dp "The password for " & strName & " has never been set."
  Else
   intTimeInterval = Int (Now - dtmValue)
   dp "The password for " & strName & " was last set on " & _
    DateValue(dtmValue) & " at " & TimeValue(dtmValue) & _
    " (" & intTimeInterval & " days ago)"

   If intTimeInterval >= iMaxAge Then
    dp "The password for " & strName & " has expired."
    UserIsExpired = True
   Else
    iRes = Int ((dtmValue + iMaxAge) - Now)
    dp "The password for " & strName & " will expire on " & _
     DateValue(dtmValue + iMaxAge) & " (" & _
     iRes & " days from today)."

    If iRes <= iDaysForEmail Then
     dp strName & " needs an email for password change"
     UserIsExpired = True
    Else
     dp strName & " does not need an email for password change"
     UserIsExpired = False
    End If
   End If

  End If
 End If
End Function

Sub ProcessFolder (objContainer, iMaxPwdAge)
 Dim objUser, iResult

 objContainer.Filter = Array ("User")

 Wscript.Echo "Checking company = " & Mid (objContainer.Name, 4)

 For each objUser in objContainer
  If Right (objUser.Name, 1) <> "$" Then
   If IsEmpty (objUser.Mail) or IsNull  (objUser.Mail) Then
    dp Mid (objUser.Name, 4) & " has no mailbox"
   Else
    If UserIsExpired (objUser, iMaxPwdAge, DAYS_FOR_EMAIL, iResult) Then
     wscript.Echo "...sending an email for " & objUser.Mail
     Call SendEmail (objUser, iResult)
    Else
     dp "...don't send an email"
    End If
   End If
  End If
 Next
End Sub

Sub SendEmail (objUser, iResult)
 Dim objMail

 Set objMail = CreateObject ("CDO.Message")

 objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing")      = 2
 objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver")     = SMTP_SERVER
 objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
 objMail.Configuration.Fields.Update

 objMail.From     = STRFROM
 objMail.To       = objUser.Mail

 objMail.Subject  = "Password needs to be set for " & Mid (objUser.Name, 4)
 objMail.Textbody = "The active directory password for user " & objUser.userPrincipalName & _
    " (" & objUser.sAMAccountName & ")" & vbCRLF & _
    "will expire in " & iResult & " days. " & vbCRLF & _
    "Please change it as soon as possible." & vbCRLF & vbCRLF & _
    "Thank you," & vbCRLF & _
    "Your email administrator"

 objMail.Send

 Set objMail = Nothing
End Sub

Sub dp (str)
 If bDebug Then
  WScript.Echo str
 End If
End Sub

 

----- edit on August 5, 2010 -----

Common issues:

[1] if you want to use scan an OU that is below the top level of the domain, you need to be careful about how you format your HOSTING_OU replacement. For example, if your domain is "example.local", and you want to scan the OU named "SubOU" which is beneath the top-level OU named "TopOU", you would need to:

        Const HOSTING_OU = "SubOU,OU=TopOU"

this be because of the way HOSTING_OU is parsed. Yes, it looks a little weird, but it works. Trust me. :-)

[2] Secondly, if you have users in HOSTING_OU and not just other OUs, then you need to make a small code change. Find this code:

  If Len (HOSTING_OU) > 0 Then
   Set objContainer = GetObject ("LDAP://OU=" & HOSTING_OU & "," & strDomainDN)
   For each objSub in objContainer
    Call ProcessFolder (objSub, numDays)
   Next
   Set objContainer = Nothing
  End If

Change it to

  If Len (HOSTING_OU) > 0 Then
   Set objContainer = GetObject ("LDAP://OU=" & HOSTING_OU & "," & strDomainDN)
   Call ProcessFolder (objContainer, numDays)  ''' add this line – that’s the only change
   For each objSub in objContainer
    Call ProcessFolder (objSub, numDays)
   Next
   Set objContainer = Nothing
  End If

Notice that there is only a single additional line added. This is arguably a bug. :-)

[3] I really need to rewrite this in PowerShell. It's so much easier! :-)

Published Tuesday, November 13, 2007 8:13 PM by michael
Filed under: , ,

Comments

Monday, December 08, 2008 5:49 AM by Passwort l?uft ab - MCSEboard.de MCSE Forum

# Passwort l?uft ab - MCSEboard.de MCSE Forum

Pingback from  Passwort l?uft ab - MCSEboard.de MCSE Forum

Sunday, January 18, 2009 9:25 AM by Email notification of expiring password? | keyongtech

# Email notification of expiring password? | keyongtech

Pingback from  Email notification of expiring password? | keyongtech

# Password Expire notification mail not functioning | keyongtech

Pingback from  Password Expire notification mail not functioning | keyongtech

# Email users when their password is about to expire | Savage Nomads

Pingback from  Email users when their password is about to expire | Savage Nomads