Send email notification for password expiration to “remote” users

Over on Michael Smith’s blog, he has a script to notify users when their password is about to expire.  This is handy for Exchange users who never log in to 22 the network because they are offsite or on an extranet (i.e., POP3/IMAP4/RPC-HTTP users).  It will crawl an OU and check the days until expiration and, if less than a variable you set, send an email via CDO.

However, at my office we don’t have these kinds of users in one OU.  They are spread across multiple domains, but are all in a local group that has permission to a web page that allows them to change their password.  So I updated the script to enumerate the members of this group.  To accommodate different password aging settings in each domain I moved the domain query for this setting into the For loop.  I also added logging so you will have a record of what was sent, not sent, and why.  This way you can schedule it or run it interactively without having to adjust the code.  Download it here, or copy below.

Option Explicit

'  No.  Per environment constants - you should change these
Const SMTP_SERVER  = "ServerName"
Const STRFROM   = "From SMTP Address"
Const DAYS_FOR_EMAIL  = 14 'Send notification when pwd will expire in this number of days
Const GROUPDN = "DN of group to enumerate"
Const LOGFILE = "Patch and filename of log file"

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

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

Dim numDays, iResult
Dim strDomain
Dim objGroup, objMember, member
Dim objFSO, objFile, strOutput

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(LOGFILE, 8, True)

Set objGroup = GetObject("LDAP://" & GROUPDN)
objFile.WriteLine "Executed at " & Now() & vbCRLF
objFile.WriteLine "Enumerating members of " & objGroup.distinguishedName & ":" & vbCRLF
For each member in objGroup.member
	Set  Мэдисон,  objMember = GetObject("LDAP://" & member)
	objFile.WriteLine objMember.distinguishedname
	strDomain = Mid(objMember.distinguishedname, InStr(objMember.distinguishedname, "DC="))
	numdays = GetMaximumPasswordAge (strDomain)
	Call ProcessUser  (and  (numDays)

objFile.WriteLine "Done. Finished at " & Now() & "."

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
		dblMaxPwdNano = Abs (objMaxPwdAge.HighPart * 2^32 + objMaxPwdAge.LowPart)
		dblMaxPwdSecs =  cheap mlb jerseys  dblMaxPwdNano * ONE_HUNDRED_NANOSECOND
		dblMaxPwdDays = Int (dblMaxPwdSecs / SECONDS_IN_DAY)
		GetMaximumPasswordAge =  Online  dblMaxPwdDays
	End  wholesale nba jerseys  If
End Function

Function UserIsExpired (objMember, iMaxAge, iDaysForEmail, iRes)
	Dim intUserAccountControl, dtmValue, intTimeInterval
	Dim strName
	On Error Resume Next
	strName = Mid (objMember.Name, 4)
	intUserAccountControl = objMember.Get ("userAccountControl")

	If intUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then
		dp "The password for " & strName & " does not expire."
		UserIsExpired = False
		iRes = 0
		dtmValue = objMember.PasswordLastChanged
			UserIsExpired = True
			dp "The password for " & strName & " has never been set."
			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
				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  wholesale jerseys  = True
					dp strName & " does not need an email for password change"
					'Swap commented variable below to force email to be sent (for testing).
					UserIsExpired = False
					'UserIsExpired = True
				End If
			End If
		End If
	End If
End Function

Sub ProcessUser (iMaxPwdAge)
	Dim iResult, strExpire
	If Right (objMember.Name, 1) <> "$" Then
		If IsEmpty (objMember.Mail) or IsNull  (objMember.Mail) Then
			dp Mid (objMember.Name, 4) & " has no mailbox"
			If UserIsExpired (objMember, iMaxPwdAge, DAYS_FOR_EMAIL, iResult) Then
				objFile.WriteLine "Sending an email to " & objMember.givenName & " " & & _
				" (" & objMember.Mail & ").  Password expires in " & iResult & " days." & vbCRLF
				Call SendEmail (iResult)
				If iResult = "" Then
					strExpire = "."
					strExpire = " for " & iResult & " days."
				End If
				objFile.WriteLine "Skipping " & objMember.givenName & " " & & _
				". Password does not expire" & strExpire & vbCRLF
			End If
		End If
	End If
End Sub

Sub SendEmail (iResult)
	Dim objMail
	Set objMail = CreateObject ("CDO.Message")
	objMail.Configuration.Fields.Item ("")      = 2
	objMail.Configuration.Fields.Item ("")     = SMTP_SERVER
	objMail.Configuration.Fields.Item ("") = 25

	objMail.From = STRFROM
	objMail.To = objMember.Mail

	objMail.Subject = "The Windows password is going to expire for " & Mid (objMember.Name, 4)
	objMail.Textbody = "The Windows Active Directory password for user " & objMember.givenName & " " & & _
	" (" & objMember.sAMAccountName & ")" & " will expire in " & iResult & " days. " & vbCRLF & vbCRLF & _
	"Please use Outlook Web Access ( to change it before it expires." & vbCRLF & vbCRLF & _
	"Thank you," & vbCRLF & _
	"Company Exchange Team" & vbCRLF & vbCRLF & _
	"Note: You have received this email because you are a member of a group that is authorized to change your " & _
	"password via Outlook    Web Access since you do not log in to the corporate network.  If this no longer applies to you, " & _
	"please notify the Company Email Team (SMTPAddress) so you can be removed from the group."

	Set objMail = Nothing
End Sub

Sub dp (str)
	If bDebug Then
		objFile.WriteLine str
	End If
End Sub

10 thoughts on “Send email notification for password expiration to “remote” users

  1. Thank you for this script. How did you make the webpage that you use to have users change their own passwords? I am needing to do something similar. Thank you.

  2. It is included in IIS6, but not in IIS7. Users can still change their password in IIS7 through OWA, but I believe it doesn’t use the iisadmpwd files that are in \windows\system32\inetsrv. Originally, I did customize the aexp2b.asp page to obfuscate it from hacker attempts and to allow only authorized users in a particular group to change their password. I have since opened it to everyone that has logged into OWA. There are articles about implementing iisadmpwd in IIS6 for OWA. If you can’t find them, or still need help, let me know.

  3. There are multiple ways to get the dn, but a non-scripting method is to just use ADSI Edit, navigate to the object, open the properties, and scroll to the distinguishedName attribute. You can just copy and paste it from there.

  4. Hi Scott,
    I am trying to implement the above code but I am getting the following error at line 30 i.e. For each member in objGroup.member
    ERROR: Object not a collection
    Code: 800A01C3
    Source: Microsoft VBScript runtime error

  5. Neal, how many users do you have in the group? If there is only one member in a group, it won’t be returned as a collection. You can work around this by retrieving the attribute with the GetEx method, which always returns the value(s) as an array. If there is only one member in the group you can verify the existing code by simply adding someone else to it.

  6. I have around 100 users in 1 OU. The code is working fine for 1 user if I eliminate the for loop as follows:

    Set objGroup = GetObject(“LDAP://” & GROUPDN)
    objFile.WriteLine “Executed at ” & Now() & vbCRLF
    objFile.WriteLine “Enumerating members of ” & objGroup.distinguishedName & “:” & vbCRLF
    ‘For Each member in objGroup.member
    Set objMember = GetObject(“LDAP://CN=Tom,OU=Dev,DC=BKEXCH,DC=COM” & member)
    objFile.WriteLine objMember.distinguishedname
    strDomain = Mid(objMember.distinguishedname,InStr(objMember.distinguishedname, “DC=”))
    numdays = GetMaximumPasswordAge (strDomain)
    Call ProcessUser (numDays)

  7. I’m trying to use your script on an SBS but I’m running into two errors — the first is the one Neal reports, saying “Object is not a collection”, and the second, when I comment out the FOR Loop like Neil suggests, is “PwdExpEmail.vbs(32,2) (null): 0x80005000.

    Line 32 in my script is the following:
    Set objMember = GetObject(“LDAP://” & member)

    The above didn’t look right to me, so I changed it to be:
    Set objMember = GetObject(“LDAP://” & member & GROUPDN) so it has a proper RDN reference, but it’s still not working, and I’m a little stumped as to why…

  8. Jesse, the member variable that is used in Line 32 is already in the form of a distinguished name, so it is sufficient to use to bind to the user object. If a member of the group isn’t a user object, I can see that being a problem because the code is not checking the object type. To ensure you are working with a collection, like I mentioned in Neal’s reply, is to use the GetEx method, which returns the attribute as a collection even if it is a single-valued attributed. After you have retrieved the group, but before the For loop, get the members as a collection, then change the For loop to use that collection:

    Dim colMembers
    colMembers = objGroup.GetEx(“member”)
    For each member in colMembers

    This should at least resolved the error about it not being a collection.

Leave a Reply

Your email address will not be published. Required fields are marked *