Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

AD user password status 3

Status
Not open for further replies.
Dbyte

Dbyte

Technical User
Mar 6, 2002
87
Goal: a text file showing the password status for every user in AD.

Problem: the script quits unexpectedly as soon as it gets to a user whose "User must change password at next logon" box is checked. My understanding is that this status should trigger the "password has expired" Else routine. No department, display name, or status appears in the text file.

Here is my code:

Code: 
On Error Resume Next

Dim oFSO, oGroup, oUser, oDomain, oMaxPwdAge, oFile
Dim iUserAccountControl, dtmValue, iTimeInterval, dblMaxPwdNano
Set oFSO = CreateObject("scripting.filesystemobject")
Set oGroup = GetObject("LDAP://ou=Departments,dc=domain,dc=somesite,dc=org")
Const ForWriting = 2
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
Const ONE_HUNDRED_NANOSECOND = .000000100
Const SECONDS_IN_DAY = 86400

Sub enumMembers(oGroup)
   For Each oUser In oGroup
      If oUser.Class = "user" Then
			iUserAccountControl = oUser.Get("userAccountControl")
			If iUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then
				oFile.WriteLine oUser.department & "/" & oUser.displayName & vbTab & "password does not expire"
			Else
				dtmValue = oUser.PasswordLastChanged
				If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
					oFile.WriteLine oUser.department & "/" & oUser.displayName & vbTab & "password has never been set"
				Else
					iTimeInterval = Int(Now - dtmValue)
					oFile.WriteLine oUser.department & "/" & oUser.displayName & vbTab & iTimeInterval & " days old"
				End If
				Set oDomain = GetObject("LDAP://dc=domain,dc=somesite,dc=org")
				Set oMaxPwdAge = oDomain.Get("maxPwdAge")
				If oMaxPwdAge.LowPart = 0 Then
					oFile.WriteLine oUser.department & "/" & oUser.displayName & vbTab & "password does not expire"
				[COLOR=red]Else
					dblMaxPwdNano = _
							Abs(oMaxPwdAge.HighPart * 2^32 + oMaxPwdAge.LowPart)
					dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND
					dblMaxPwdDays = Int(dblMaxPwdSecs / SECONDS_IN_DAY)
					If iTimeInterval >= dblMaxPwdDays Then
						oFile.WriteLine oUser.department & "/" & oUser.displayName & vbTab & "password has expired."
					End If
				End If[/color]
			End If
		ElseIf oUser.Class = "organizationalUnit" or oUser.Class = "container" Then
			enumMembers(oUser)
		End If
	Next
End Sub

Set oFile = oFSO.CreateTextFile("PasswordStatus.txt", ForWriting, True)
Call enummembers(ogroup)

Code above derived from with further assistance from
If I run the script from the MSDN page against the user who causes my script to fail I get a "Maximum password age is 360 days" response (<- removed from my script) followed by "The password has expired".

The part of the script where I think the error resides is in red. Thanks in advance for any assistance.
 
Sort by date Sort by votes
Use error trapping.

Code: 
Set objUser = GetObject _
   ("LDAP://CN=UserName,CN=users,DC=spidersparlor,DC=local")
On Error Resume Next
dtmValue = objUser.PasswordLastChanged
If Err.Number = "-2147463155" Then
	WScript.Echo "Password must be changed on next logon."
Else
	WScript.Echo "Password last changed: " & dtmValue
End If

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at
Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.
 
Upvote 0 Downvote
I have updated my code as follows:
Code: 
Sub enumMembers(oGroup)
   For Each oUser In oGroup
      If oUser.Class = "user" Then
			iUserAccountControl = oUser.Get("userAccountControl")
			If iUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then
				oFile.WriteLine oUser.department & "/" & oUser.displayName & vbTab & "password does not expire"
			Else
				dtmValue = oUser.PasswordLastChanged
				[COLOR=red]If Err.Number = "-2147463155" Then
					oFile.WriteLine oUser.department & "/" & oUser.displayName & vbTab & "password must be changed on next logon"
				Else[/color]
					If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
						oFile.WriteLine oUser.department & "/" & oUser.displayName & vbTab & "password has never been set"
					Else
						iTimeInterval = Int(Now - dtmValue)
						oFile.WriteLine oUser.department & "/" & oUser.displayName & vbTab & iTimeInterval & " days old"
					End If
					Set oDomain = GetObject("LDAP://dc=domain,dc=somesite,dc=org")
					Set oMaxPwdAge = oDomain.Get("maxPwdAge")
					If oMaxPwdAge.LowPart = 0 Then
						oFile.WriteLine oUser.department & "/" & oUser.displayName & vbTab & "password does not expire"
					Else
						iTimeInterval = Int(Now - dtmValue)
						dblMaxPwdNano = _
							Abs(oMaxPwdAge.HighPart * 2^32 + oMaxPwdAge.LowPart)
						dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND
						dblMaxPwdDays = Int(dblMaxPwdSecs / SECONDS_IN_DAY)
						If iTimeInterval >= dblMaxPwdDays Then
							oFile.WriteLine oUser.department & "/" & oUser.displayName & vbTab & "password has expired"
						End If
					End If
				End If
			End If
		ElseIf oUser.Class = "organizationalUnit" or oUser.Class = "container" Then
			enumMembers(oUser)
		End If
	Next
End Sub

Mark, I added a snippet from your code above in red. The user does not appear to be tripping this error condition's routine. However, if I run your code in its entirety on the same user who is crashing my script it works & I get the "password must be changed..." message. I also temporarily moved the user to another part of AD that isn't being scanned, & the script broke on the next user who has the same "password must be changed..." box checked.

I think I may have it in the wrong sequence, but I can't change it to Option Explicit to find out. Any thoughts where I should put your code snippet &/or anything else that might be breaking it?
 
Upvote 0 Downvote
Give this a try.
Code: 
Sub enumMembers(oGroup)
	Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
	On Error Resume Next   
	For Each oUser In oGroup      
		If oUser.Class = "user" Then            
			'Check if user must change password
			Set objUser = GetObject("LDAP://" & oUser)
			dtmValue = oUser.PasswordLastChanged                
			If Err.Number = "-2147463155" Then                    
				oFile.WriteLine oUser.department & "/" & oUser.displayName & vbTab & "password must be changed on next logon"                
			Else                    
				'Check if password does not expire
				iUserAccountControl = oUser.Get("userAccountControl")
				If iUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then                
					oFile.WriteLine oUser.department & "/" & oUser.displayName & vbTab & "password does not expire"
		        End If
			End If
			'If the property is nto found password has never been set
			If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
	           oFile.WriteLine oUser.department & "/" & oUser.displayName & vbTab & "password has never been set"
		    Else
		    	'Otherwise assume the value is good and convert it to days old                        
				iTimeInterval = Int(Now - dtmValue)                        
				oFile.WriteLine oUser.department & "/" & oUser.displayName & vbTab & iTimeInterval & " days old"
	        End If
	        Set oDomain = GetObject("LDAP://dc=domain,dc=somesite,dc=org")
	        Set oMaxPwdAge = oDomain.Get("maxPwdAge")
	        If oMaxPwdAge.LowPart = 0 Then
	            oFile.WriteLine oUser.department & "/" & oUser.displayName & vbTab & "password does not expire"
	        Else                        
				iTimeInterval = Int(Now - dtmValue)
	            dblMaxPwdNano = Abs(oMaxPwdAge.HighPart * 2^32 + oMaxPwdAge.LowPart)
	            dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND
	            dblMaxPwdDays = Int(dblMaxPwdSecs / SECONDS_IN_DAY)
	            If iTimeInterval >= dblMaxPwdDays Then
	                oFile.WriteLine oUser.department & "/" & oUser.displayName & vbTab & "password has expired"
	            End If
	        End If                
		
	    ElseIf oUser.Class = "organizationalUnit" or oUser.Class = "container" Then
	            enumMembers(oUser)
	    End If
	Next
End Sub


I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at
Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.
 
Upvote 0 Downvote
Markdmac's code works (no big surprise really). I'm gonna make a few more tweaks to remove some redundant messages in the .txt file. Once this is done I'll post the finalized code here for all.

Thanks again Mark!
 
Upvote 0 Downvote
Happy to assist.

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at
Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.
 
Upvote 0 Downvote
Here is the final code:
Code: 
On Error Resume Next

'Variable declaration
Dim oFSO, oGroup, oUser, oDomain, oMaxPwdAge, oExcel, oWorkbook
Dim iRow, iUserAccountControl, dtmValue, iTimeInterval, dblMaxPwdNano
Set oFSO = CreateObject("scripting.filesystemobject")
Set oGroup = GetObject("[COLOR=blue]LDAP://ou=Departments,dc=domain,dc=somesite,dc=org[/color]")
Set oExcel = CreateObject("Excel.Application")
Set oWorkbook = oExcel.Workbooks.Open("[COLOR=blue]C:\Scripts\ExpiringPasswords.xls[/color]")
oExcel.DisplayAlerts = False
iRow = 2
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
Const ONE_HUNDRED_NANOSECOND = .000000100
Const SECONDS_IN_DAY = 86400

'Sub to recursively search AD for user password info
Sub enumMembers(oGroup)
   On Error Resume Next
	Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D   
   For Each oUser In oGroup      
      If oUser.Class = "user" Then                
			Set oUser = GetObject("LDAP://" & oUser)
			oExcel.Cells(iRow, 1).Value = oUser.department
			oExcel.Cells(iRow, 2).Value = oUser.displayName
			dtmValue = oUser.PasswordLastChanged
			iUserAccountControl = oUser.Get("userAccountControl")
			'Check if password does not expire
			If iUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then                
				oExcel.Cells(iRow, 3).Value = "password does not expire"
			'If property is not found password has never been set
			ElseIf Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
				oExcel.Cells(iRow, 3).Value = "password has never been set"
			'Check if password needs to be changed @ next logon
			ElseIf Err.Number = "-2147463155" Then                    
				oExcel.Cells(iRow, 3).Value = "password must be changed on next logon"            
			Else
				'The password is good -> convert to days old                        
				iTimeInterval = Int(Now - dtmValue)
				Set oDomain = GetObject("[COLOR=blue]LDAP://dc=domain,dc=somesite,dc=org[/color]")
				Set oMaxPwdAge = oDomain.Get("maxPwdAge")                       
					iTimeInterval = Int(Now - dtmValue)
					dblMaxPwdNano = Abs(oMaxPwdAge.HighPart * 2^32 + oMaxPwdAge.LowPart)
					dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND
					dblMaxPwdDays = Int(dblMaxPwdSecs / SECONDS_IN_DAY)
				'If password age is larger than defined max age
				If iTimeInterval >= dblMaxPwdDays Then
					oExcel.Cells(iRow, 3).Value = "password has expired"
				'Write password age
				Else
					oExcel.Cells(iRow, 3).Value = iTimeInterval & " days old"
				End If
			End If
			iRow = iRow + 1
		ElseIf oUser.Class = "organizationalUnit" or oUser.Class = "container" Then
			enumMembers(oUser)
		End If
   Next
End Sub

'Format Excel file
oExcel.Rows(1).Font.Bold = TRUE
oExcel.Rows(1).HorizontalAlignment = -4108
oExcel.Cells(1, 1).Value = "[COLOR=blue]DEPARTMENT[/color]"
oExcel.Cells(1, 2).Value = "[COLOR=blue]USER[/color]"
oExcel.Cells(1, 3).Value = "[COLOR=blue]PASSWORD STATUS[/color]"

'Call Subroutine
Call enummembers(ogroup)

'Save & close workbook, then quit Excel
oExcel.ActiveWorkBook.Close True
oExcel.Quit

'Clean up & quit script
Set oFSO = Nothing
Set oGroup = Nothing
Set oUser = Nothing
Set oDomain = Nothing
Set oMaxPwdAge = Nothing
Set oExcel = Nothing
Set oWorkbook = Nothing
MsgBox "Finished updating [COLOR=blue]ExpiringPasswords.xls[/color]"
WScript.Quit

The parts in blue should be updated for your environment. I also made the following changes:
1. Saved output to Excel file for easier sorting
2. Changed order of ops to remove redundant entries in file
3. Better commenting!

BIG thanks again to markdmac for providing the key pieces of code.

Hope this helps someone else out.
 
Upvote 0 Downvote
I would replace this line:
Code: 
Set oDomain = GetObject("LDAP://dc=domain,dc=somesite,dc=org")

With the following lines so the script will no longer require editing for the domain.
Code: 
Set oRootDSE = GetObject("LDAP://rootDSE")
Set oDomain = GetObject _ 
("LDAP://" & oRootDSE.get("DefaultNamingContext"))

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at
Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

bdwilcox
  • Question
Trying to adapt VBScript to search if machine is in an AD group 6
Replies
8
Views
811
SoftwareRT
SoftwareRT
Z3braa
  • Locked
  • Question
Remove specific computer name in Logon Workstation from from all users in AD, with VBScript
Replies
0
Views
123
Z3braa
Z3braa
queen_mszdia
  • Locked
  • Question
invoke runas different user from inside VbScript
Replies
0
Views
125
queen_mszdia
queen_mszdia
GessWurker1
  • Locked
  • Question
problem with AD query, empty values and form field population
Replies
0
Views
89
GessWurker1
GessWurker1
Stevehewitt
  • Locked
  • Question
Update AD attribute using current user
Replies
0
Views
57
Stevehewitt
Stevehewitt

Part and Inventory Search

Sponsor

Back
Top