VB script for Active Directory help

Hello:

I have implemented this script in my domain. However, the script still sends an email out for accounts that are set not to expire and to disabled accounts.

Does anybody have any suggestions to prevent the notifications for these two cases? The desired outcome of the script is to only send the notification out to enabled users with an expiring password.

Thank you in advance.
sysadmin-inqAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

RobSampsonCommented:
Hi, see if this works for you.

Regards,

Rob.

'========================================================================== 
'Milan on 1/12/2011 
' This script can be used to notify users of when their windows passords 
' are going to expire. Especially useful in those cases where user does not logon 
' to windows with individual login and uses OWA for email 
' Script is currently running fine in a Exchange 2010 env with AD 2008 
'========================================================================== 
On Error Resume Next 
Const ADS_SCOPE_SUBTREE = 2 
Const SEC_IN_DAY = 86400 
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000 ' tocheck for accounts that have "no expire" set on the password 
Const ADS_UF_ACCOUNTDISABLE = 2

Dim maxPwdAge 
maxpwdage = 90 'set this according to policy in your organization 
Dim numDays 
Dim warningDays 
warningDays = 14 ' set this according to policy in your organization 
 
'ADO to access Active Directory 
Set objConnection = CreateObject("ADODB.Connection") 
Set objCommand = CreateObject("ADODB.Command") 
objConnection.Provider = "ADsDSOObject" 
objConnection.Open "Active Directory Provider" 
Set objCommand.ActiveConnection = objConnection 
Set objRootDSE = GetObject("LDAP://rootDSE") 
 
DomainString = objRootDSE.Get("dnsHostName") 
 
objCommand.Properties("Page Size") = 1000 
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
 
objCommand.CommandText = "SELECT DisplayName,mail,DistinguishedName,sAMAccountName  FROM 'LDAP://OU=regions, DC=vsc, DC=com'" & _ 
    " where objectClass='user'" 
    '" WHERE objectCategory='user'" 'This was creating problems where it was picking up two objects that were contacts, not users 
Set objRecordSet = objCommand.Execute 
 
objRecordSet.MoveFirst 'get to the first record in the recordset 
Do Until objRecordSet.EOF 
    strUser = objRecordSet.Fields("sAMAccountName").Value 
    strDN = objRecordSet.Fields("DistinguishedName").Value   'This is important otherwise we cannot pull the "last Password Change date 
    strMail = objRecordSet.Fields("mail").Value 
    strFullName = objRecordSet.Fields("DisplayName").Value 
   
	For Each objItem in strUser  'one record at a time 
		Set objUserLDAP = GetObject ("LDAP://" & strDN & "") 
		intCurrentValue = objUserLDAP.Get("userAccountControl") ' For checking if the account is disabled 
		
		' If the account is disabled, skip it
		If Not (intCurrentValue And ADS_UF_ACCOUNTDISABLE) Then
            
			'******************************************************************************************* 
			'BEGIN OF PASSWORD EXPIRATION WARNING 
			'******************************************************************************************* 
			accountExpires = objUserLDAP.AccountExpirationDate
			If accountExpires = "1/1/1970" Or accountExpires = "1/01/1601 10:00:00 AM" Or Err.Number = -2147467259 Then
				' Account never expires
			Else
				numDays = maxpwdage 
				dtVal = objUserLDAP.PasswordLastChanged 'The latest date the user changed her/his password 
				whenPasswordExpires = DateAdd("d", numDays, dtval) 
				fromDate = Date 
				daysLeft = DateDiff("d",fromDate,whenPasswordExpires) 
				If (daysLeft < warningDays) and (daysLeft > 0) then  'If 14 days or less remain until Password expires 
				If strMail <> "" Then 
				Set objEmail = CreateObject("CDO.Message") 
				objEmail.From = "admin@watchdog" 
				objEmail.To = strmail 
				objemail.cc = "xxxxxx@xxx.com" 
				objEmail.Subject = strFullname & ", your Windows Password is expiring soon!!"  
				objEmail.HTMLBody = "Your Password Expires in " & daysLeft & " day(s)" & vbcrlf & _ 
				"<h3>Windows users - Press CTRL-ALT-DEL and select the CHANGE A PASSWORD option</h3>" & vbcrlf & _ 
				"<h3>Outlook Web Users - Please click (Options) and choose (Change your Password)</h3>" & vbcrlf & _ 
				"<h3>This reminder will continue until you change your password</h3>" & vbcrlf & _ 
				"<h3> Please do not reply to this email</h3>" 
				objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 
				objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "192.168.xx.xx" 
				 objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
				objEmail.Configuration.Fields.Update 
				objEmail.Send 
			End If 
		End If
	Next 
	objRecordSet.MoveNext ' Keep going down the table 
Loop 
 
Set objConnection = Nothing 
Set objCommand = Nothing 
Set objCommand.ActiveConnection = Nothing 
Set objRootDSE = Nothing 
Set objRecordSet = Nothing 
Set objUserLDAP = Nothing 
Set objEmail = Nothing 
WScript.Quit 

Open in new window

0
sysadmin-inqAuthor Commented:
Hi Rob,

Thanks for the reply I have test the script and it was missing two End If statements before line 83. I have added them, however the script still send email to disabled users and now detects some expiring accounts as "never expires".

I will research more to see how AD distinguishes between expiring and disabled accounts.

Regards,
NetAdmin
0
RobSampsonCommented:
Hi, it looks like there were a couple of errors there.....try this code.

Regards,

Rob.

'========================================================================== 
'Milan on 1/12/2011 
' This script can be used to notify users of when their windows passords 
' are going to expire. Especially useful in those cases where user does not logon 
' to windows with individual login and uses OWA for email 
' Script is currently running fine in a Exchange 2010 env with AD 2008 
'========================================================================== 
'On Error Resume Next 
Const ADS_SCOPE_SUBTREE = 2 
Const SEC_IN_DAY = 86400 
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000 ' tocheck for accounts that have "no expire" set on the password 
Const ADS_UF_ACCOUNTDISABLE = 2

Dim maxPwdAge 
maxpwdage = 90 'set this according to policy in your organization 
Dim numDays 
Dim warningDays 
warningDays = 14 ' set this according to policy in your organization 
 
'ADO to access Active Directory 
Set objConnection = CreateObject("ADODB.Connection") 
Set objCommand = CreateObject("ADODB.Command") 
objConnection.Provider = "ADsDSOObject" 
objConnection.Open "Active Directory Provider" 
Set objCommand.ActiveConnection = objConnection 
Set objRootDSE = GetObject("LDAP://rootDSE") 
 
DomainString = objRootDSE.Get("dnsHostName") 
 
objCommand.Properties("Page Size") = 1000 
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
 
objCommand.CommandText = "SELECT DisplayName,mail,DistinguishedName,sAMAccountName  FROM 'LDAP://OU=regions,DC=vsc,DC=com'" & _ 
    " where objectClass='user'" 
    '" WHERE objectCategory='user'" 'This was creating problems where it was picking up two objects that were contacts, not users 
Set objRecordSet = objCommand.Execute 
 
objRecordSet.MoveFirst 'get to the first record in the recordset 
Do Until objRecordSet.EOF 
    strUser = objRecordSet.Fields("sAMAccountName").Value 
    strDN = objRecordSet.Fields("DistinguishedName").Value   'This is important otherwise we cannot pull the "last Password Change date 
    strMail = objRecordSet.Fields("mail").Value 
    strFullName = objRecordSet.Fields("DisplayName").Value 
   
	Set objUserLDAP = GetObject ("LDAP://" & strDN & "") 
	intCurrentValue = objUserLDAP.Get("userAccountControl") ' For checking if the account is disabled 
	
	' If the account is disabled, skip it
	If intCurrentValue And ADS_UF_ACCOUNTDISABLE Then
		' Account is disabled
    Else
		'******************************************************************************************* 
		'BEGIN OF PASSWORD EXPIRATION WARNING 
		'******************************************************************************************* 
		accountExpires = objUserLDAP.AccountExpirationDate
		If accountExpires = "1/1/1970" Or accountExpires = "1/01/1601 10:00:00 AM" Or Err.Number = -2147467259 Then
			' Account never expires
			'WScript.Echo "Account never expires"
		Else
			numDays = maxPwdAge 
			dtVal = objUserLDAP.PasswordLastChanged 'The latest date the user changed her/his password 
			whenPasswordExpires = DateAdd("d", numDays, dtval) 
			fromDate = Date 
			daysLeft = DateDiff("d",fromDate,whenPasswordExpires)
			If (daysLeft < warningDays) and (daysLeft > 0) then  'If 14 days or less remain until Password expires 
				If strMail <> "" Then 
					Set objEmail = CreateObject("CDO.Message") 
					objEmail.From = "admin@watchdog" 
					objEmail.To = strMail 
					objemail.cc = "xxxxxx@xxx.com" 
					objEmail.Subject = strFullname & ", your Windows Password is expiring soon!!"  
					objEmail.HTMLBody = "Your Password Expires in " & daysLeft & " day(s)" & vbcrlf & _ 
					"<h3>Windows users - Press CTRL-ALT-DEL and select the CHANGE A PASSWORD option</h3>" & vbcrlf & _ 
					"<h3>Outlook Web Users - Please click (Options) and choose (Change your Password)</h3>" & vbcrlf & _ 
					"<h3>This reminder will continue until you change your password</h3>" & vbcrlf & _ 
					"<h3> Please do not reply to this email</h3>" 
					objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 
					objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "192.168.xx.xx" 
					 objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
					objEmail.Configuration.Fields.Update 
					objEmail.Send
				End If
			End If
		End If 
	End If
	objRecordSet.MoveNext ' Keep going down the table 
Loop 
 
Set objConnection = Nothing 
Set objCommand.ActiveConnection = Nothing 
Set objCommand = Nothing 
Set objRootDSE = Nothing 
Set objRecordSet = Nothing 
Set objUserLDAP = Nothing 
Set objEmail = Nothing 
WScript.Quit 

Open in new window

0
Cloud Class® Course: Ruby Fundamentals

This course will introduce you to Ruby, as well as teach you about classes, methods, variables, data structures, loops, enumerable methods, and finishing touches.

sysadmin-inqAuthor Commented:
Hi Rob:

I have been away from the office. I tried this script and get an error messaging at line 55 can not be "null". If I put an "On Error Resume Next" the error goes away but no emails is sent out.

Any suggestions?

Thanks for your time.
0
RobSampsonCommented:
If you get an error on that line, that means the account it was looking at doesn't have an expiration date.  Run this code using
cscript C:\Scripts\CheckExpiration.vbs

and you will see some output to know what it's doing.

Regards,

Rob,

'========================================================================== 
'Milan on 1/12/2011 
' This script can be used to notify users of when their windows passords 
' are going to expire. Especially useful in those cases where user does not logon 
' to windows with individual login and uses OWA for email 
' Script is currently running fine in a Exchange 2010 env with AD 2008 
'========================================================================== 
'On Error Resume Next 
Const ADS_SCOPE_SUBTREE = 2 
Const SEC_IN_DAY = 86400 
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000 ' tocheck for accounts that have "no expire" set on the password 
Const ADS_UF_ACCOUNTDISABLE = 2

Dim maxPwdAge 
maxpwdage = 90 'set this according to policy in your organization 
Dim numDays 
Dim warningDays 
warningDays = 14 ' set this according to policy in your organization 
 
'ADO to access Active Directory 
Set objConnection = CreateObject("ADODB.Connection") 
Set objCommand = CreateObject("ADODB.Command") 
objConnection.Provider = "ADsDSOObject" 
objConnection.Open "Active Directory Provider" 
Set objCommand.ActiveConnection = objConnection 
Set objRootDSE = GetObject("LDAP://rootDSE") 
 
DomainString = objRootDSE.Get("dnsHostName") 
 
objCommand.Properties("Page Size") = 1000 
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
 
objCommand.CommandText = "SELECT DisplayName,mail,DistinguishedName,sAMAccountName  FROM 'LDAP://OU=regions,DC=vsc,DC=com'" & _ 
    " where objectClass='user'" 
    '" WHERE objectCategory='user'" 'This was creating problems where it was picking up two objects that were contacts, not users 
Set objRecordSet = objCommand.Execute 
 
objRecordSet.MoveFirst 'get to the first record in the recordset 
Do Until objRecordSet.EOF 
    strUser = objRecordSet.Fields("sAMAccountName").Value 
    strDN = objRecordSet.Fields("DistinguishedName").Value   'This is important otherwise we cannot pull the "last Password Change date 
    strMail = objRecordSet.Fields("mail").Value 
    strFullName = objRecordSet.Fields("DisplayName").Value 
   
	Set objUserLDAP = GetObject ("LDAP://" & strDN & "") 
	intCurrentValue = objUserLDAP.Get("userAccountControl") ' For checking if the account is disabled 
	
	' If the account is disabled, skip it
	If intCurrentValue And ADS_UF_ACCOUNTDISABLE Then
		' Account is disabled
    Else
		'******************************************************************************************* 
		'BEGIN OF PASSWORD EXPIRATION WARNING 
		'******************************************************************************************* 
		On Error Resume Next
		accountExpires = objUserLDAP.AccountExpirationDate
		If accountExpires = "1/1/1970" Or accountExpires = "1/01/1601 10:00:00 AM" Or Err.Number = -2147467259 Then
			' Account never expires
			WScript.Echo "Account for " & objUserLDAP.samAccountName & " never expires"
		Else
			Err.Clear
			On Error GoTo 0
			numDays = maxPwdAge 
			dtVal = objUserLDAP.PasswordLastChanged 'The latest date the user changed her/his password 
			whenPasswordExpires = DateAdd("d", numDays, dtval) 
			fromDate = Date 
			daysLeft = DateDiff("d",fromDate,whenPasswordExpires)
			WScript.Echo "Account for " & objUserLDAP.samAccountName & " expires in " & daysLeft & " days."
			If (daysLeft < warningDays) and (daysLeft > 0) then  'If 14 days or less remain until Password expires 
				If strMail <> "" Then 
					Set objEmail = CreateObject("CDO.Message") 
					objEmail.From = "admin@watchdog" 
					objEmail.To = strMail 
					objemail.cc = "xxxxxx@xxx.com" 
					objEmail.Subject = strFullname & ", your Windows Password is expiring soon!!"  
					objEmail.HTMLBody = "Your Password Expires in " & daysLeft & " day(s)" & vbcrlf & _ 
					"<h3>Windows users - Press CTRL-ALT-DEL and select the CHANGE A PASSWORD option</h3>" & vbcrlf & _ 
					"<h3>Outlook Web Users - Please click (Options) and choose (Change your Password)</h3>" & vbcrlf & _ 
					"<h3>This reminder will continue until you change your password</h3>" & vbcrlf & _ 
					"<h3> Please do not reply to this email</h3>" 
					objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 
					objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "192.168.xx.xx" 
					 objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
					objEmail.Configuration.Fields.Update 
					objEmail.Send
				End If
			End If
		End If 
	End If
	objRecordSet.MoveNext ' Keep going down the table 
Loop 
 
Set objConnection = Nothing 
Set objCommand.ActiveConnection = Nothing 
Set objCommand = Nothing 
Set objRootDSE = Nothing 
Set objRecordSet = Nothing 
Set objUserLDAP = Nothing 
Set objEmail = Nothing 
WScript.Quit 

Open in new window

0
sysadmin-inqAuthor Commented:
Hi Rob,

Thanks for all your help with this script. The confusion came because, I was looking to exclude the "Password never expires" setting in AD not the expiration of the AD object itself.

I poked around in ADSI edit and found that the password never expires setting is controlled by the userAccountControl attribute. Normal accounts have a value of 512. If an account is set to never expire the value change to 66048. Below is the script the will send an warning notification if the account is not disable or if the Password never expires is not checked.

Thanks again,
NetAdmin

'========================================================================== 
'Milan on 1/12/2011 
' This script can be used to notify users of when their windows passords 
' are going to expire. Especially useful in those cases where user does not logon 
' to windows with individual login and uses OWA for email 
' Script is currently running fine in a Exchange 2010 env with AD 2008 
'========================================================================== 
'On Error Resume Next 
Const ADS_SCOPE_SUBTREE = 2 
Const SEC_IN_DAY = 86400 
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000 ' tocheck for accounts that have "no expire" set on the password 
Const ADS_UF_ACCOUNTDISABLE = 2

Dim maxPwdAge 
maxpwdage = 90 'set this according to policy in your organization 
Dim numDays 
Dim warningDays 
warningDays = 14 ' set this according to policy in your organization 
 
'ADO to access Active Directory 
Set objConnection = CreateObject("ADODB.Connection") 
Set objCommand = CreateObject("ADODB.Command") 
objConnection.Provider = "ADsDSOObject" 
objConnection.Open "Active Directory Provider" 
Set objCommand.ActiveConnection = objConnection 
Set objRootDSE = GetObject("LDAP://rootDSE") 
 
DomainString = objRootDSE.Get("dnsHostName") 
 
objCommand.Properties("Page Size") = 1000 
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
 
objCommand.CommandText = "SELECT DisplayName,mail,DistinguishedName,sAMAccountName  FROM 'LDAP://OU=regions,DC=vsc,DC=com'" & _ 
    " where objectClass='user'" 
    '" WHERE objectCategory='user'" 'This was creating problems where it was picking up two objects that were contacts, not users 
Set objRecordSet = objCommand.Execute 
 
objRecordSet.MoveFirst 'get to the first record in the recordset 
Do Until objRecordSet.EOF 
    strUser = objRecordSet.Fields("sAMAccountName").Value 
    strDN = objRecordSet.Fields("DistinguishedName").Value   'This is important otherwise we cannot pull the "last Password Change date 
    strMail = objRecordSet.Fields("mail").Value 
    strFullName = objRecordSet.Fields("DisplayName").Value 
   
	Set objUserLDAP = GetObject ("LDAP://" & strDN & "") 
	intCurrentValue = objUserLDAP.Get("userAccountControl") ' For checking if the account is disabled 
	
	' If the account is disabled, skip it
	If intCurrentValue And ADS_UF_ACCOUNTDISABLE Then
		' Account is disabled
    Else
		'******************************************************************************************* 
		'BEGIN OF PASSWORD EXPIRATION WARNING 
		'******************************************************************************************* 
		If intCurrentValue = "66048" Then
			' Password never expires
			'WScript.Echo "Password never expires"
		Else
			numDays = maxPwdAge 
			dtVal = objUserLDAP.PasswordLastChanged 'The latest date the user changed her/his password 
			whenPasswordExpires = DateAdd("d", numDays, dtval) 
			fromDate = Date 
			daysLeft = DateDiff("d",fromDate,whenPasswordExpires)
			If (daysLeft < warningDays) and (daysLeft > 0) then  'If 14 days or less remain until Password expires 
				If strMail <> "" Then 
					Set objEmail = CreateObject("CDO.Message") 
					objEmail.From = "admin@watchdog" 
					objEmail.To = strMail 
					objemail.cc = "xxxxxx@xxx.com" 
					objEmail.Subject = strFullname & ", your Windows Password is expiring soon!!"  
					objEmail.HTMLBody = "Your Password Expires in " & daysLeft & " day(s)" & vbcrlf & _ 
					"<h3>Windows users - Press CTRL-ALT-DEL and select the CHANGE A PASSWORD option</h3>" & vbcrlf & _ 
					"<h3>Outlook Web Users - Please click (Options) and choose (Change your Password)</h3>" & vbcrlf & _ 
					"<h3>This reminder will continue until you change your password</h3>" & vbcrlf & _ 
					"<h3> Please do not reply to this email</h3>" 
					objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 
					objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "192.168.xx.xx" 
					 objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
					objEmail.Configuration.Fields.Update 
					objEmail.Send
				End If
			End If
		End If 
	End If
	objRecordSet.MoveNext ' Keep going down the table 
Loop 
 
Set objConnection = Nothing 
Set objCommand.ActiveConnection = Nothing 
Set objCommand = Nothing 
Set objRootDSE = Nothing 
Set objRecordSet = Nothing 
Set objUserLDAP = Nothing 
Set objEmail = Nothing 
WScript.Quit 

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
RobSampsonCommented:
Oh whoops....I think in my script this line
	If intCurrentValue And ADS_UF_ACCOUNTDISABLE Then

Open in new window


should have been
	If intCurrentValue And ADS_UF_DONT_EXPIRE_PASSWD Then

Open in new window


Anyhow, thanks for the points, I'm glad you got a working solution.

Regards,

Rob.
0
sysadmin-inqAuthor Commented:
Accepted my own solution as it contains the working script. Gave Rob all the points as he did all the trouble shooting.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.