Do more with
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
Premium Content
You need an Expert Office subscription to comment.Start Free Trial