Dim objCommand, objConnection, strBase
Dim strFilter, strAttributes, strPasswordChangeDate, intPassAge
Dim lngTZBias, objPwdLastSet, strEmailAddress
Dim objShell, lngBiasKey, k, PasswordExpiry, strRootDomain
Dim strQuery, objRecordset, strName, strCN
Dim objEmail, objFSO, strDisabled, debugMode
Dim debugEmail, SMTPServer, owaURL, supportContact

debugMode = “True”
debugEmail = “test@yourdomain.com”

‘ // Enter the number of days passwords are good for in your domain
PasswordExpiry = 90
‘ // Enter domain information
strRootDomain = “dc=yourdomain,dc=com”
‘ // URL or IP of SMTP Server
SMTPServer = “mail.yourdomain.com”
‘ // URL to OWA server for e-mail message
owaURL = “https://mail.yourdomain.com/owa”
supportContact = “Joe Blow (xxx) xxx-xxxx”

Set objShell = CreateObject(“Wscript.Shell”)
lngBiasKey = objShell.RegRead(“HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias”)

‘ // HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias
‘ //This value is the current time difference from Greenwich Mean Time (GMT) in minutes and is the difference for GMT.
‘ // For example, if you’re 1 hour ahead, GMT is 1 hour behind. The value would be ffffffc4, which is hexadecimal for -60.
‘ // Need to ensure this is in a format we can use.
If UCase(TypeName(lngBiasKey)) = “LONG” Then
lngTZBias = lngBiasKey
ElseIf UCase(TypeName(lngBiasKey)) = “VARIANT()” Then
lngTZBias = 0
For k = 0 To UBound(lngBiasKey)
lngTZBias = lngTZBias + (lngBiasKey(k) * 256^k)
Next
End If

Set objCommand = CreateObject(“ADODB.Command”)
Set objConnection = CreateObject(“ADODB.Connection”)
objConnection.Provider = “ADsDSOObject”
objConnection.Open “Active Directory Provider”
objCommand.ActiveConnection = objConnection
strBase = “<LDAP://” & strRootDomain & “>”

‘ // Filter on users do not have “password never expires”
‘ // or “password not required” set.
‘ // userAccountControl:1.2.840.113556.1.4.803:=65536 ‘ // User accounts with no pwd expiry
‘ // userAccountControl:1.2.840.113556.1.4.803:=32 ‘ // User accounts with no pwd required
‘ // userAccountControl:1.2.840.113556.1.4.803:=2 ‘ // Checks to see if the account is disabled
strFilter = “(&(objectCategory=person)(objectClass=user)” _
& “(!userAccountControl:1.2.840.113556.1.4.803:=65536)” _
& “(!userAccountControl:1.2.840.113556.1.4.803:=32)” _
& “(!userAccountControl:1.2.840.113556.1.4.803:=2))”
strAttributes = “sAMAccountName,cn,mail,pwdLastSet”
strQuery = strBase & “;” & strFilter & “;” & strAttributes & “;subtree”
objCommand.CommandText = strQuery
objCommand.Properties(“Page Size”) = 100
objCommand.Properties(“Timeout”) = 30
objCommand.Properties(“Cache Results”) = False
Set objRecordSet = objCommand.Execute

‘ // Debug mode pops up messages (WScript) while the script is running.
‘ // Also e-mails a debug e-mail account rather than the user
If debugMode = “True” then
WScript.echo “Today’s date used in password calculations: ” & FormatDateTime(Date() ,1)
End if

Do Until objRecordSet.EOF
strName = objRecordSet.Fields(“sAMAccountName”).Value
strCN = objRecordSet.Fields(“cn”).value

strEmailAddress = objRecordSet.Fields(“mail”).value

Set objPwdLastSet = objRecordset.Fields(“pwdLastSet”).Value

strPasswordChangeDate = Integer8Date(objPwdLastSet, lngTZBias)
intPassAge = DateDiff(“d”, strPasswordChangeDate, Now)

if debugMode = “True” then
Wscript.Echo “NT Name: ” & strName & “, Common Name: ” & strCN & vbCRLF & vbCRLF _
& vbTab & “Password last changed at ” & strPasswordChangeDate & vbCRLF & vbCRLF _
& vbTab & “Password changed ” & intPassAge & ” days ago” & vbCRLF & vbCRLF _
& vbTab & “E-mail: ” & strEmailAddress & vbCRLF & vbCRLF _
& vbTAB & “Password Change Date: ” & strPasswordChangeDate
End If

If not ( strPasswordChangeDate = “1/1/1601″) then ‘ // Filter new users who have to change their password at first login.
‘ // If a password change has never happened the date of last password changed
‘ // is equal to January 1st, 1601.
If (intPassAge > PasswordExpiry) Then
If debugMode = “True” then
WScript.echo vbTab & “Sending user notification to ” _
& strEmailAddress & ” that password has expired”
End if
Call SendEmailMessage(strEmailAddress, 0)
ElseIf intPassAge = (PasswordExpiry – 1) Then
If debugMode = “True” then
WScript.echo vbTab & “Sending user notification to ” _
& strEmailAddress & ” that password expires in 1 days”
End if
Call SendEmailMessage(strEmailAddress, 1)
ElseIf intPassAge = (PasswordExpiry – 2) Then
If debugMode = “True” then
WScript.echo vbTab & “Sending user notification to ” _
& strEmailAddress & ” that password expires in 2 days”
End if
Call SendEmailMessage(strEmailAddress, 2)
ElseIf intPassAge = (PasswordExpiry – 3) Then
If debugMode = “True” then
WScript.echo vbTab & “Sending user notification to ” _
& strEmailAddress & ” that password expires in 3 days”
End if
Call SendEmailMessage(strEmailAddress, 3)
ElseIf intPassAge = (PasswordExpiry – 4) Then
If debugMode = “True” then
WScript.echo vbTab & “Sending user notification to ” _
& strEmailAddress & ” that password expires in 4 days”
End if
Call SendEmailMessage(strEmailAddress, 4)
ElseIf intPassAge = (PasswordExpiry – 5) Then
If debugMode = “True” then
WScript.echo vbTab & “Sending user notification to ” _
& strEmailAddress & ” that password expires in 5 days”
End if
Call SendEmailMessage(strEmailAddress, 5)
ElseIf intPassAge = (PasswordExpiry – 6) Then
If debugMode = “True” then
WScript.echo vbTab & “Sending user notification to ” _
& strEmailAddress & ” that password expires in 6 days”
End if
Call SendEmailMessage(strEmailAddress, 6)
ElseIf intPassAge = (PasswordExpiry – 7) Then
If debugMode = “True” then
WScript.echo vbTab & “Sending user notification to ” _
& strEmailAddress & ” that password expires in 8 days”
End if
Call SendEmailMessage(strEmailAddress, 7)
ElseIf intPassAge = (PasswordExpiry – 8) Then
If debugMode = “True” then
WScript.echo vbTab & “Sending user notification to ” _
& strEmailAddress & ” that password expires in 8 days”
End if
Call SendEmailMessage(strEmailAddress, 8)
End If
End If

objRecordSet.MoveNext
Loop

objConnection.Close

Function Integer8Date(objDate, lngBias)
Dim lngAdjust, lngDate, lngHigh, lngLow

lngAdjust = lngBias
lngHigh = objDate.HighPart
lngLow = objdate.LowPart

If lngLow < 0 Then
lngHigh = lngHigh + 1
End If

If (lngHigh = 0) And (lngLow = 0) Then
lngAdjust = 0
End If

lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) + lngLow) / 600000000 – lngAdjust) / 1440

On Error Resume Next
Integer8Date = CDate(lngDate)
If Err.Number <> 0 Then
On Error GoTo 0
Integer8Date = #1/1/1601#
End If
On Error GoTo 0

End Function

Sub SendEmailMessage (strDestEmail,strNoOfDays)

Set objEmail = CreateObject(“CDO.Message”)
Set objFSO = CreateObject(“Scripting.FileSystemObject”)
Set objShell = WScript.CreateObject (“WScript.Shell”)

If IsNull(strDestEmail) Then
If debugMode = “True” then
Wscript.Echo “No email address, no message sent.”
End If
Exit Sub
End If

objEmail.From = “Password_manager@1stAmericard.com”
If debugMode = “True” then
objEmail.To = debugEmail
wscript.echo “Using debug e-mail address: ” & debugEmail
Else
objEmail.To = strDestEmail
End if
objEmail.Subject = “Your e-mail password is set to expire in ” & strNoOfDays & ” days!!”
objEmail.Textbody = “The password for account ” & strDestEmail & ” will expire in ” & strNoOfDays & ” days!!” & vbCRLF & vbCRLF _
& “It is very important that you change your password before it expires. Here is some important information ” _
& “you will need regarding your password.” & vbCRLF & vbCRLF _
& “Current password policy:” & vbCRLF _
& vbTAB & ” 1) Passwords are only good for 90 days” & vbCRLF _
& vbTAB & ” 2) Passwords must be unique. You cannot reuse your last 4 passwords” & vbCRLF _
& vbTAB & ” 3) Passwords must be strong and contain 3 of the following 4 classes of characters” & vbCRLF _
& vbTAB & vbTAB & ” a) Upper case characters (i.e. ABCDE….)” & vbCRLF _
& vbTAB & vbTAB & ” b) Lower case characters (i.e. abcde….)” & vbCRLF _
& vbTAB & vbTAB & ” c) Numbers (i.e. 12345….)” & vbCRLF _
& vbTAB & vbTAB & ” d) Special characters (i.e. !@#$%….)” & vbCRLF & vbCRLF _
& “For security reasons, it is recommended that you use a pass phrase rather than a password. Pass ” _
& “phrases contain spaces and are much more secure.” & vbCRLF _
& “Examples of pass phrases are: ” & vbCRLF & vbCRLF _
& vbTAB & ” My spouse is groovy!” & vbCRLF _
& vbTAB & ” I shot a 76″ & vbCRLF _
& vbTAB & ” My 4 kids” & vbCRLF & vbCRLF _
& “How to change your password” & vbCRLF _
& vbTAB & “1) Go to ” & owaURL & ” and log into your Outlook Web Access account.” & vbCRLF _
& vbTAB & “2) Select OPTIONS in the upper right hand corner.” & vbCRLF _
& vbTAB & “3) Click on the CHANGE PASSWORD option on the left column.” & vbCRLF _
& vbTAB & “4) Type your old password and your new password based upon the above criteria.” & vbCRLF & vbCRLF & vbCRLF _
& “Please note that Outlook Web Access is designed primarily for use on Internet Explorer. ” _
& “We have received several reports of issues with users on Apple computers trying to change thier password. ” _
& “If you require assistance, please contact ” & supportContact

objEmail.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/sendusing“) = 2
objEmail.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/smtpserver“) = SMTPServer
objEmail.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/smtpserverport“) = 25
objEmail.Configuration.Fields.Update
objEmail.Send