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.