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.