VB Script Needed to query information in Active Directory

Hi, here's the addition of two extra columns: Date Account Expires, and Date Password Expires.

Regards,

Rob.

Const ADS_UF_ACCOUNTDISABLE = 2
Const CHANGE_PASSWORD_GUID = "{AB721A53-1E2F-11D0-9819-00AA0040529B}"
Const ADS_RIGHT_DS_CONTROL_ACCESS = &H100
Const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &H5
Const ADS_ACETYPE_ACCESS_DENIED_OBJECT = &H6
Const ADS_ACEFLAG_OBJECT_TYPE_PRESENT = &H1
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
Const E_ADS_PROPERTY_NOT_FOUND  = &h8000500D
Const ONE_HUNDRED_NANOSECOND    = .000000100
Const SECONDS_IN_DAY            = 86400

strOutputFile = "User_Details.csv"

strOUPath = ""

Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
If Trim(strOUPath) <> "" Then
	If Right(strOUPath, 1) <> "," Then strOUPath = strOUPath & ","
Else
	strOUPath = ""
End If
objCommand.ActiveConnection = objConnection
objCommand.CommandText = _
    "<GC://" & strOUPath & strDNSDomain & ">;(objectCategory=User)" & _
        ";userAccountControl,distinguishedName;subtree"  
Set objRecordSet = objCommand.Execute
 
strDetails = """User Name"",""First Name"",""Last Name"",""Description"",""Office"",""Telephone Number"",""Email"",""Web Page"",""Street"",""City"",""State"",""Zip"",""Notes"",""Cannot Change Password"",""Will Never Expire"",""Disabled"",""Date Account Expires"",""Date Password Expires"""
Do Until objRecordset.EOF
    Set objUser = GetObject("LDAP://" & objRecordset.Fields("distinguishedName"))
    If TypeName(objUser.Description) = "Variant" Then
    	strDescription = Join(objUser.Description)
    Else
    	strDescription = objUser.Description
    End If
    On Error Resume Next
    strEmail = objUser.Mail
    Err.Clear
    On Error GoTo 0
    strDetails = strDetails & VbCrLf & """" & objUser.samAccountName & """," & _
    	"""" & objUser.givenName & """," & _
       	"""" & objUser.sn & """," & _
		"""" & strDescription & """," & _
		"""" & objUser.physicalDeliveryOfficeName & """," & _
		"""" & objUser.telephoneNumber & """," & _
		"""" & strEmail & """," & _
		"""" & objUser.wwwHomePage & """," & _
		"""" & objUser.StreetAddress & """," & _
		"""" & objUser.C & """," & _
		"""" & objUser.St & """," & _
		"""" & objUser.postalCode & """," & _
		"""" & objUser.Notes & ""","

	' Search the ACE to see if SELF has Cannnot Change Password
	' Bind to the user security objects.
	Set objSecDescriptor = objUser.Get("ntSecurityDescriptor")
	Set objDACL = objSecDescriptor.discretionaryAcl
	
	For Each objACE In objDACL
	    If (UCase(objACE.Trustee) = "NT AUTHORITY\SELF") _
		And (UCase(objACE.objectType) = CHANGE_PASSWORD_GUID) _
		And (objACE.AceFlags = 0) _
		And (objACE.AccessMask = ADS_RIGHT_DS_CONTROL_ACCESS) _
		And (objACE.Flags =  ADS_ACEFLAG_OBJECT_TYPE_PRESENT) Then
	        If (objACE.AceType = ADS_ACETYPE_ACCESS_DENIED_OBJECT) Then
				strDetails = strDetails & """Yes"","
			Else
				strDetails = strDetails & """No"","
	        End If
	    End If
	Next

	On Error Resume Next
    accountExpires = objUser.AccountExpirationDate
	If accountExpires = "1/1/1970" Or accountExpires = "1/01/1601 10:00:00 AM" Or Err.Number = -2147467259 Then
		strDetails = strDetails & """No"","
		strDateAccountExpires = "NEVER"
	ElseIf CDate(accountExpires) < Now Then
		strDetails = strDetails & """Yes"","
		strDateAccountExpires = CDate(accountExpires)
	Else
		strDetails = strDetails & """Unknown"","
		strDateAccountExpires = "UNKNOWN"	
	End If
	Err.Clear
	On Error GoTo 0
    If intUAC And ADS_UF_ACCOUNTDISABLE Then
        strDetails = strDetails & """Yes"","
	Else
		strDetails = strDetails & """No"","
    End If
    strDetails = strDetails & """" & strDateAccountExpires & ""","
    
    ' Determine the date the password expires
	intUserAccountControl = objUser.Get("userAccountControl")
	If intUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then
		strPWExpiration = "NEVER"
	Else
		dtmValue = objUser.PasswordLastChanged
		Set objDomain = GetObject("LDAP://" & strDNSDomain)
		Set objMaxPwdAge = objDomain.Get("maxPwdAge")
	
		If objMaxPwdAge.LowPart = 0 Then
			strPWExpiration = "NEVER"
		Else
			dblMaxPwdNano = Abs(objMaxPwdAge.HighPart * 2^32 + objMaxPwdAge.LowPart)
			dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND
			dblMaxPwdDays = Int(dblMaxPwdSecs / SECONDS_IN_DAY)
			If intTimeInterval >= dblMaxPwdDays Then
				strPWExpiration = "EXPIRED"
			Else
				strPWExpiration = DateValue(dtmValue + dblMaxPwdDays)
			End If
		End If
	End If
	strDetails = strDetails & """" & strPWExpiration & """"
	
    objRecordset.MoveNext
Loop

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOutputFile = objFSO.CreateTextFile(strOutputFile, True)
objOutputFile.Write strDetails
objOutputFile.Close
Set objOutputFile = Nothing
Set objFSO = Nothing

MsgBox "Done. Please see " & strOutputFile

Select all Open in new window