[AccessD] Setting up a Domain : Code for Listing Users

Drew Wutka DWUTKA at Marlow.com
Tue Jun 23 12:38:14 CDT 2009


Here's a function to list User Data:  (Watch for line wrap)

Function ListADUsers()
On Error GoTo ErrorHandler
Dim Comm As ADODB.Command
Dim rs As ADODB.Recordset
Dim strSQL As String
Dim strCurrentDomain As String
Dim cnn As ADODB.Connection
Dim strResult As String
Set cnn = New ADODB.Connection
cnn.Provider = "ADsDSOObject"
cnn.Open "Active Directory Provider"
Set Comm = New Command
Comm.ActiveConnection = cnn
Comm.Properties("Page Size") = 100
Comm.Properties("Timeout") = 60
Comm.Properties("Sort On") = "samAccountName"
Comm.Properties("Cache Results") = False
strCurrentDomain =
GetObject("LDAP://RootDSE").Get("defaultNamingContext")
strSQL = "<LDAP://" & strCurrentDomain & _
">;(&(objectCategory=person)(objectClass=user));samAccountName,Name,sn,g
ivenName,AdsPath,userAccountControl;subtree"
Comm.CommandText = strSQL
Set rs = Comm.Execute
If rs.EOF = False Then
    rs.MoveFirst
    Do Until rs.EOF = True
        strResult = UCase(rs.Fields(0).Value)
        If Not IsNull(rs.Fields(3).Value) Then strResult = strResult & "
FirstName: " & rs.Fields(3).Value
        If Not IsNull(rs.Fields(2).Value) Then strResult = strResult & "
LastName: " & rs.Fields(2).Value
        If Not IsNull(rs.Fields(1).Value) Then strResult = strResult & "
FullName: " & rs.Fields(1).Value
        If Not IsNull(rs.Fields(4).Value) Then strResult = strResult & "
ADSString: " & rs.Fields(4).Value
        If Not IsNull(rs.Fields(5).Value) Then strResult = strResult & "
userAccountControl: " & rs.Fields(5).Value
        Debug.Print strResult
        rs.MoveNext
    Loop
End If
rs.Close
Set rs = Nothing
Set Comm = Nothing
cnn.Close
Set cnn = Nothing

Exit Function

ErrorHandler:

If Err.Number = -2147023541 Then
    Err.Clear
Else
    If Err.Number = 457 Then
        Resume Next
    Else
        MsgBox Err.Number & " - " & Err.Description
    End If
End If
End Function

Same as the Computer object, that MSDN site can be used to look at the
fields for a User object.  Some interesting notes.  Exchange 2000 (and
later) is integrated with Active Directory, so you can get user email
addresses, however, a user can have more then one email address, so to
get the default address:

On Error GoTo ErrorHandler
Dim user 'As IADsUser
Set user = GetObject(ADSString)
EmailAddress = user.EmailAddress
Exit Property

ErrorHandler:

Err.Clear
EmailAddress = ""

Where ADSString would be the value in the function above.  In the system
I built that uses the code (though I'm adding data to a class and
collection, not debug.print) above, the individual class objects use the
above code to supply the email address of the user in question.

Drew
The information contained in this transmission is intended only for the person or entity 
to which it is addressed and may contain II-VI Proprietary and/or II-VI Business 
Sensitive material. If you are not the intended recipient, please contact the sender 
immediately and destroy the material in its entirety, whether electronic or hard copy. 
You are notified that any review, retransmission, copying, disclosure, dissemination, 
or other use of, or taking of any action in reliance upon this information by persons 
or entities other than the intended recipient is prohibited.





More information about the AccessD mailing list