[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 487
  • Last Modified:

Need help with a vbs script that checks expiring passwords and auto emails

Hi there,

I googled some scripts to be able to do this and finally chose to go with this one: http://www.sheenaustin.com/2009/06/19/active-directory-password-expiry-reminder-email/

However, I'm having some trouble implementing it. I downloaded the file, which was a .vbs, changed it to .txt and edited it to specify our domain. Then, following the instructions on the blog, I created a cscript file and put both the .vbs script and the script files in the same folder on the C: drive. I was unable to edit the cscript file so that it could invoke the .vbs script and after some trial and error, I currently have this written in my cscript:
cscript PasswordExpiryEmail.vbs>PwdExpyEmail.log

When changing the cscript to .bat and running it, i just get a cmd window that hangs. Closing out the cmd window creates an output to the log file in the same directory, which contains the following:
C:\PasswordExpiryEmail>cscript PasswordExpiryEmail.vbs 1>PwdExpyEmail.log

Any idea on how I can configure this script to get it working?

  • 3
  • 3
1 Solution
HAve you checked if the script works even without the bat?

I mean, run it from cmd window and run

cscript C:\PasswordExpiryEmail\PasswordExpiryEmail.vbs

and look for any trouble in the script.
If everything works fine, maybe could help to write the full path for cscript and PasswordExpiryEmail.vbs

C:\Windows\System32\cscript.exe C:\PasswordExpiryEmail\PasswordExpiryEmail.vbs

You can add the option //b to cscript to use Batch mode, that suppresses script errors and prompts from displaying

Another option could be about permission.
clloccAuthor Commented:
I tried running it from the cmd window using the command u suggested and got the following message

C:\Documents and Settings\Administrator>cscript C:\PasswordExpiryEmail\PasswordE
Microsoft (R) Windows Script Host Version 5.6
Copyright (C) Microsoft Corporation 1996-2001. All rights reserved.

C:\PasswordExpiryEmail\PasswordExpiryEmail.vbs(46, 1) Provider: Table does not e

Open in new window

I'm unsure what table its asking for...
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

clloccAuthor Commented:
Also, here is the code I am using:
Option Explicit

Dim objCommand, objConnection, objChild, objUserConnection, strBase, strFilter, strAttributes, strPasswordChangeDate, intPassAge
Dim lngTZBias, objPwdLastSet, strEmailAddress, objMessage
Dim objShell, lngBiasKey, k, PasswordExpiry, strRootDomain, strFromEmailAdd, strSMTPServerName, strSMTPServerPort
Dim strQuery, objRecordset, strName, strCN

' ********************* CHANGE THESE VALUES TO PASSWORD EXPIRY AND ROOT OF WHERE USERS WILL BE SEARCHED ***********************************


' *****************************************************************************************************************************************

' Obtain local Time Zone bias from machine registry.
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")
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)
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 & ">"

' strFilter = "(&(objectCategory=person)(objectClass=user))"
strFilter = "(&(objectCategory=person)(objectClass=user) (!userAccountControl:1.2.840.113556.1.4.803:=2)(!userAccountControl:1.2.840.113556.1.4.803:=65536))"
strAttributes = "sAMAccountName,cn,mail,pwdLastSet,distinguishedName"
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

' WScript.echo "Running at " & Date()

Do Until objRecordSet.EOF
  strName = objRecordSet.Fields("sAMAccountName").Value
  strCN = objRecordSet.Fields("cn").value
  strEmailAddress = objRecordSet.Fields("mail").value
  Wscript.Echo "NT Name: " & strName & ", Common Name: " & strCN & ", Email Address:" & strEmailAddress

  Set objUserConnection = GetObject("LDAP://" & objRecordSet.Fields("distinguishedName").Value)
  Set objPwdLastSet = objUserConnection.pwdLastSet
  strPasswordChangeDate = Integer8Date(objPwdLastSet, lngTZBias)
  WScript.Echo vbTab & "Password last changed at " & strPasswordChangeDate
  intPassAge = DateDiff("d", strPasswordChangeDate, Now)
  WScript.Echo vbTab & "Password changed " & intPassAge & " days ago"

  If intPassAge = (PasswordExpiry-3) Then
    WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 3 days"
    Call SendEmailMessage(strEmailAddress, 3)
  ElseIf intPassAge = (PasswordExpiry-6) Then
    WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 6 days"
    Call SendEmailMessage(strEmailAddress, 6)
  ElseIf intPassAge = (PasswordExpiry-9) Then
    WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 9 days"
    Call SendEmailMessage(strEmailAddress, 9)
  End If



Function Integer8Date(objDate, lngBias)
' Function to convert Integer8 (64-bit) value to a date, adjusted for
' local time zone bias.
  Dim lngAdjust, lngDate, lngHigh, lngLow
  lngAdjust = lngBias
  lngHigh = objDate.HighPart
  lngLow = objdate.LowPart
  ' Account for error in IADslargeInteger property methods.
  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
' Trap error if lngDate is overly large
  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)
  WScript.echo "Sending Email to:" & strDestEmail
  Set objMessage = CreateObject("CDO.Message") 
  objMessage.Subject = "Password Expires in " & strNoOfDays & " days" 
  objMessage.From = strFromEmailAdd
  objMessage.To = strDestEmail 
  objMessage.TextBody = "Your password expires in " & strNoOfDays & " days. Please change your password now to prevent getting locked out of the network." 
  objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
  objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPServerName ' Your mailserver here
  objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = strSMTPServerPort
End Sub

Open in new window

I think that in line 11 you should use


because this is your root domain. Could you modify and try again?
clloccAuthor Commented:
Yea that did it! I didnt add the //b option to the cscript, would I add that to the beginning or the end?
Its working great now, and I've been tweaking it to our company's specifications.  

I was trying to add objMessage.AddAttachment “c:\passwordpolicy.pdf”  but it seems there would be an error and nothing would output in in log file and no emails would get sent out.

In the meantime I've added instructions right in the message body but it would be nice to attach a pdf with instructions.

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

  • 3
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now