Written on September 20, 2005 at 1:25 pm by jayb

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

Filed under no comments

Hello there! If you are new here, you might want to subscribe to the RSS feed for updates on this topic.

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