sidefumbling

Send email notification for password expiration to “remote” users

By Scott, September 19, 2005 9:18 AM

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 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

' 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 ADS_UF_DONT_EXPIRE_PASSWD = &h10000
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 (numDays)
Next

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

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 (objMember, iMaxAge, iDaysForEmail, iRes)
	Dim intUserAccountControl, dtmValue, intTimeInterval
	Dim strName
	On Error Resume Next
	Err.Clear
	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
	Else
		iRes = 0
		dtmValue = objMember.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"
					'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"
		Else
			If UserIsExpired (objMember, iMaxPwdAge, DAYS_FOR_EMAIL, iResult) Then
				objFile.WriteLine "Sending an email to " & objMember.givenName & " " & objMember.sn & _
				" (" & objMember.Mail & ").  Password expires in " & iResult & " days." & vbCRLF
				Call SendEmail (iResult)
			Else
				If iResult = "" Then
					strExpire = "."
				Else
					strExpire = " for " & iResult & " days."
				End If
				objFile.WriteLine "Skipping " & objMember.givenName & " " & objMember.sn & _
				". 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 ("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 = 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.sn & _
	" (" & objMember.sAMAccountName & ")" & " will expire in " & iResult & " days. " & vbCRLF & vbCRLF & _
	"Please use Outlook Web Access (https://www.company.com) 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."

	objMail.Send
	Set objMail = Nothing
End Sub

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

Exchange 2003, Exchange 2007, VBScript | inline code

7 Responses to “Send email notification for password expiration to “remote” users”

Craig says:

August 20, 2009 at 9:14 AM

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.
scott says:

August 20, 2009 at 12:18 PM

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.
matt says:

October 6, 2010 at 7:17 AM

Can you tell us how we can located the DN of the group we wish to enumerate?
Scott says:

October 6, 2010 at 8:18 AM

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.
Neal says:

November 9, 2010 at 2:00 AM

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
Scott says:

November 9, 2010 at 7:47 AM

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.
Neal says:

November 9, 2010 at 8:25 AM

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)
‘Next

What Am I Reading
Planned books:

None

Current books:

None

Recent books:
- The Hole in Our Gospel by Richard Stearns
- The Screwtape Letters by C. S. Lewis
- Windows PowerShell 2.0 by Don Jones, Jeffery Hicks
- Where Men Win Glory: The Odyssey of Pat Tillman by Jon Krakauer
- One Day by David Nicholls
View full Library
Geocaching
Categories
Archives

The consequence of not having six hydrocoptic marzelvanes.

Send email notification for password expiration to “remote” users

7 Responses to “Send email notification for password expiration to “remote” users”

Leave a Reply

What Am I Reading

Planned books:

Current books:

Recent books:

Geocaching

Categories

Archives