×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

VBScript FAQ

Domain Admin

Notifying users via e-mail that their password is about to expire by computerhighguy
Posted: 10 Aug 07 (Edited 20 Aug 07)

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.

--------------------------------------------------------
--------------------------------------------------------
Option Explicit

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

End Sub


Back to VBScript FAQ Index
Back to VBScript Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close