Notify AD user with mail when password expires

In my environment, i have a lot of users, which never comes to the office, but need remote access to the company network. for this they have an AD user account, which password will expires for company policy after 90 days. Cause they never logon to a domain computer, they didn’t get the “Change Password Request” when the password expires. So they will have at one day an blocked account, but needing it for syncing mobile phone or remote access over VPN. So i wrote a litle script which will notify every user per Mail about the expiring password:

You can dowload the script UserNotification-PasswordExpiration.vbs or copy/paste it from here:

' ===========================================================================================
'
'   Script Information
'
'   Title:              UserNotification-PasswordExpiration.vbs
'   Author:             Josh Burkard
'   Date:               01.07.2011
'   Description:        - Notify AD-users X days before password expiration through email
'
'                       - you have to set this five variables:
'                           - days to notify Users before password expiration
'                           - OU's
'                           - sender-address
'                           - mail-server
'                           - domain (line 29)
' ===========================================================================================
Const intMinDays = 10
strOUs = Array ( "OU=OU1,DC=domain,DC=local", "OU=OU2,DC=domain,DC=local")
Const strMailFrom = "it@domain.org"
Const strMailServer = "mail.domain.org"

Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
Const E_ADS_PROPERTY_NOT_FOUND  = &h8000500D
Const ONE_HUNDRED_NANOSECOND = .000000100
Const SECONDS_IN_DAY = 86400

' Get MaxPasswordAge
'
Set objDomain = GetObject("LDAP://DC=domain,DC=local")
Set objMaxPwdAge = objDomain.Get("maxPwdAge")

If objMaxPwdAge.LowPart = 0 Then
	' The Maximum Password Age is set to 0 in the domain. Therefore, the password for all users does not expire.
	WScript.Quit
Else
	dblMaxPwdNano = Abs(objMaxPwdAge.HighPart * 2^32 + objMaxPwdAge.LowPart)
	dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND
	dblMaxPwdDays = Int(dblMaxPwdSecs / SECONDS_IN_DAY)
End If

For Each strOU In strOUs
	' Create connection to AD
	'
	Set objConnection = CreateObject("ADODB.Connection")
	objConnection.Open "Provider=ADsDSOObject;"

	' Create command
	'
	Set objCommand = CreateObject("ADODB.Command")
	objCommand.ActiveConnection = objConnection

	' Execute command to get all users in OU
	'
	objCommand.CommandText = "<LDAP://" & strOU & ">;(&(objectclass=user)(objectcategory=person));adspath,distinguishedname,sAMAccountName;Mail;subtree"
	Set objRecordSet = objCommand.Execute

	On Error Resume Next

	' Show info for each user in OU
	'
	Do Until objRecordSet.EOF

		' Show required info for a user
		'
		strUserDN = objRecordSet.Fields("distinguishedname").Value

		Set objUser = GetObject("LDAP://" & strUserDN)
		If instr(lcase(objUser.distinguishedName), "ou=users inactive") = false AND instr(lcase(objUser.distinguishedName), "ou=service accounts") = false AND instr(lcase(objUser.distinguishedName), "ou=public") = false Then
			' The User is not in one of the special OU
			intUserAccountControl = objUser.Get("userAccountControl")

			If intUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then
				' The password does not expire.
			Else
				' WScript.Echo "The password expires."
				dtmValue = objUser.PasswordLastChanged

				If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
					' The password has never been set
					Err.Clear()
				Else
					' The passord has been set and will expire
					intDaysTillExpiration = Int(dtmValue - Now + dblMaxPwdDays)
					If intDaysTillExpiration = 10 Then
						' The password will expire in 10 days. The user will be notified.
						SendNotification objUser.Get("givenName") & " " & objUser.Get("sn"), objUser.Get("mail"), intDaysTillExpiration, DateValue(dtmValue + dblMaxPwdDays) & " / " & TimeValue(dtmValue + dblMaxPwdDays)
					End If
				End If
			End If
		End If

		' Move to the next user
		'
		objRecordSet.MoveNext
	Loop

	' Clean up
	'
	objRecordSet.Close
	Set objRecordSet = Nothing
	Set objCommand = Nothing
	objConnection.Close
	Set objConnection = Nothing
Next

Function SendNotification (strName, strEmail, intDaysTillExpiration, strDate)
	Set objEmail = CreateObject("CDO.Message")
	objEmail.From = strMailFrom
	objEmail.To = strEmail
	objEmail.Subject = "Windows-Kennwort"
	objEmail.Textbody = "Hello " & strName & Chr(13) & Chr(10) & Chr(13) & Chr(10) & _
						"Your windows password will expire in " & intDaysTillExpiration & " days. After this you can't use it anymore and can't logon to the Company XYZ network. " & Chr(13) & Chr(10) & _
						"Please change your password at any windows computer inside the Company XYZ network before " & strDate & "." & Chr(13) & Chr(10) & Chr(13) & Chr(10) & _
						"For any questions or problems, please contact your IT departement " & strMailFrom
	objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
	objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strMailServer
	objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
	objEmail.Configuration.Fields.Update
	objEmail.Send
	Set objEmail = Nothing
End Function