March 16, 2024

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

I can’t wait until we get all of our users on the Exchange 2003 server and give this a try!

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

[Via Michael’s meanderings…]

Jason Benway

Christ follower, husband, father, IT geek, and Xbox gamer

View all posts by Jason Benway →