Determine old AD Users and Computers

First, I have to thank gtog in thread183-587842 for his basic code there....it lead me down the path to victory.

My boss wanted a way to search all users and computers in Active Directory and determine stale (older than 90 days) accounts. According to Microsoft and MSDN, the AD key in question would be the pwdLastSet. But this is a crazy long integer. More research and I found that the PasswordLastChanged key is the pwdLastSet key converted to readable day and time. I also found a few references to VB scripts for checking a single user.

Not being a true VB programmer, I began searching for ways to do this same stuff in Access. And I finally found it. Here it is if you are interested.

Create a new database and make sure you have a reference to the Microsoft DAO 3.6 object library. Create a new table called tblAccounts and include the following fields:

Account String 255 Primary Key
NeverExpires Yes/No
LastDate Date/Time General Format
Expired Yes/No
WillExpire Date/Time General Format

Paste the following into a new module:

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

Sub QueryAD(strType As String)
On Error Resume Next
Set oConnection1 = CreateObject("ADODB.Connection")
Set oCommand1 = CreateObject("ADODB.Command")
' Open the connection.
oConnection1.Provider = "ADsDSOObject" ' This is the ADSI OLE-DB provider name
oConnection1.Open "Active Directory Provider"
' Create a command object for this connection.
Set oCommand1.ActiveConnection = oConnection1
' Compose a search string.
If strType = "Users" Then
oCommand1.CommandText = "SELECT * FROM 'LDAP://ldapservername' WHERE objectcategory ='Person' AND objectclass='User'"
Else
oCommand1.CommandText = "SELECT * FROM 'LDAP://ldapservername' WHERE objectcategory ='Computer'"
End If
' Execute the query.
Set rs = oCommand1.Execute
DoCmd.RunSQL ("DELETE * FROM tblAccounts")
Dim rsAccounts As DAO.Recordset
Set rsAccounts = CurrentDb.OpenRecordset("tblAccounts", dbOpenDynaset)
'--------------------------------------
' Navigate the record set
'--------------------------------------
With rsAccounts
Do While Not rs.EOF
Set objUser = GetObject(rs.Fields(0))
If objUser.Get("userAccountControl") And &H10000 Then
.AddNew
.Fields("Account") = Mid(objUser.Name, 4)
.Fields("NeverExpires") = True
.Update
Else
.AddNew
.Fields("Account") = Mid(objUser.Name, 4)
.Fields("LastDate") = objUser.PasswordLastChanged
.Fields("Expired") = IIf(objUser.PasswordLastChanged <= DateAdd("d", -90, Date), True, False)
.Fields("WillExpire") = DateAdd("d", 90, objUser.PasswordLastChanged)
.Update
End If
rs.MoveNext
Loop
End With
End Sub

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

To find the expired users, simply use:

Call QueryAD("Users")

and for computers its:

Call QueryAD("Computers")

Your info will appear in the table for your editing/querying/exporting/etc.