Automatic Password Expiration Email
This script will go through the OU you specify and email the users that their password will expire.
-
Dim oConnection ‘As ADODB.Connection
-
Dim oRecordSet ‘As ADODB.RecordSet
-
Dim strQuery ‘As String
-
Dim strDomainNC ‘As String
-
Dim oRootDSE ‘As IADs
-
Dim oDirObject ‘As Variant
-
Dim vArgs, x
-
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
-
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
-
-
On Error Resume Next
-
-
‘ Find the domain naming context
-
set oRootDSE = GetObject("LDAP://RootDSE")
-
strDomainNC = oRootDSE.Get("defaultNamingContext")
-
set oRootDSE = Nothing
-
-
‘ Setup the ADO connection
-
Set oConnection = CreateObject("ADODB.Connection")
-
oConnection.Provider = "ADsDSOObject"
-
oConnection.Open "ADs Provider"
-
Set vArgs = WScript.Arguments
-
-
if VArgs.Count <> 2 Then
-
wscript.echo "USAGE: cscript expirepassemail.vbs "
-
wscript.echo "USAGE: cscript expirepassemail.vbs 110 120"
-
wscript.quit
-
end if
-
-
min = vArgs(0)
-
max = vArgs(1)
-
-
Set oCommand = CreateObject("ADODB.Command")
-
Set oCommand.ActiveConnection = oConnection
-
oCommand.CommandText= "," & strDomainNC & ">;(objectCategory=user);distinguishedName,cn,name;subTree"
-
oCommand.Properties("searchscope") = 2
-
oCommand.Properties("Page Size") = 1000
-
oCommand.Properties("Timeout") = 15
-
Set oRecordSet = oCommand.Execute
-
-
if oRecordSet.Eof then
-
response.write "No objects were found"
-
WScript.Quit(0)
-
Else
-
Dim vClasses ‘As Variant
-
Dim strClass ‘As String
-
Dim mysid ‘As variant
-
-
wscript.echo "List of users and password information"
-
wscript.echo " Max: " & max & ", Min: " & min
-
wscript.echo "————————————–"
-
-
‘ Iterate through the objects that are in the query results
-
-
While Not oRecordset.Eof
-
Set usr = GetObject("LDAP://" & oRecordset.Fields("distinguishedName").Value)
-
If (instr(usr.SamAccountName, "$") = 0) and instr(usr.adspath, ".Global") = 0 Then
-
Err.Number = 0
-
dtmValue = Usr.PasswordLastChanged
-
If Err.Number <> E_ADS_PROPERTY_NOT_FOUND Then
-
flags = usr.get("userAccountControl")
-
If flags And ADS_UF_DONT_EXPIRE_PASSWD Then
-
expire = "noexpire"
-
Else
-
expire = "Expires"
-
End if
-
If (int(DateDiff("d", dtmValue, Date)) > int(min)) and (int(DateDiff("d", dtmValue, Date)) < int(max)) Then
-
wscript.echo usr.cn & " " & expire & " in " & 120-DateDiff("d", dtmValue, Date) & " days"
-
if 120-DateDiff("d", dtmValue, Date) < 0 then
-
wscript.echo " Expired! " & 120-DateDiff("d", dtmValue, Date)
-
Set objMessage = CreateObject("CDO.Message")
-
objMessage.Subject = usr.cn & " Expired"
-
objMessage.Sender = "DoNotReply "
-
objMessage.From = "Do Not Reply"
-
objMessage.To = ""
-
objMessage.TextBody = usr.samaccountname & " has already expired."
-
objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
-
objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = ""
-
objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
-
objMessage.Configuration.Fields.Update
-
‘ objMessage.Send
-
else
-
response.write 120-DateDiff("d", dtmValue, Date)
-
Set objMessage = CreateObject("CDO.Message")
-
objMessage.Subject = "Your network and email password is expiring"
-
objMessage.Sender = "DoNotReply "
-
objMessage.From = "Do Not Reply"
-
objMessage.To = usr.samaccountname & "@"
-
objMessage.TextBody = usr.samaccountname & "@ : Your password will expire in " & 120-DateDiff("d", dtmValue, Date) & " days! Please change it to avoid disruptions."
-
objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
-
objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = ""
-
objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
-
objMessage.Configuration.Fields.Update
-
objMessage.Send
-
end if
-
End If
-
End If
-
End If
-
oRecordset.MoveNext
-
Wend
-
End If
-
-
‘Clean up
-
Set oRecordset = Nothing
-
Set oConnection = Nothing


It however can be fixed easily with a few of these badboys. Today isn’t looking good. It’s pouring rain and crappy out. Looks like today is going to be a nice day to close early.