Most companies I have ever worked for have off site people. Even if they connect to the network via a VPN client, these users will not get a pop up notifying them that thier password will expire in X days. The only way to enable this functionality is to put a hardware VPN at thier location (very expensive and usually very slow). I have asked sales people to make an entry on thier calander 90 days after they change thier password as a reminder. I have even gone as far as to make a recurring schedule on thier calander. Nothing worked. So I created the following script that will go through the AD and e-mail users whose passwords are expiring in 8 days or less. Now there really is not excuse for those pesky sales people. :) If you set debugMode = "True" then it will pop up messages as the script runs (assumes WScript) and will e-mail the message to the debugEmail address instead of the recipients. The top of the script contains just about all the custom information in variables that most people will use.
Assumptions: 1) You are running Exchange with OWA enabled. 2) Your OWA is configured to allow for password changes. 3) The e-mail address of the user is thier primary address as specified in the AD object.
Disclaimer: I started out with someone else's script and then modified it greatly. I don't know who that person was.
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
' // 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
' // 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
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
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
Talk To Other Members