Importing users from AD into a table (1 Viewer)

[shabbaranks]

Hi,

This code was copied from another location (not this forum) and before I just copied and pasted it I wanted to understand what exactly it was doing and how to trigger it correctly.

Private Sub Form_load()
Public Sub TestCode(strDomain As String, strGroup As String)
     Dim objGroup As Object
     Dim objRootDSE As Object
     Dim objNet As Object
     Dim strDomain As Variant
     Dim objUser As Object
     Dim db As DAO.Database
     Dim rs As DAO.Recordset
     Dim strSQL As String
     Dim strGroup As String
     Dim i As Integer
    Set db = CurrentDb
     'Get one record just so we have a record set to add to.
     strSQL = "SELECT TOP 1 * FROM ADUsers"
     Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
    Set objNet = CreateObject("WScript.Network")
     Set objRootDSE = GetObject("[URL]ldap://rootDSE[/URL]")
     Set objGroup = GetObject("WinNT://" & strDomain & "/" & strGroup & ",group")
     For Each objUser In objGroup.Members
         i = i + 1
         With rs
             .AddNew
             !UserName = objUser.Name
             .Update
         End With
     Next
     Set rs = Nothing
     Set db = Nothing
     Set objGroup = Nothing
     Set objRootDSE = Nothing
     Set objNet = Nothing
End Sub
End Sub

What Im trying to do firstly is learn how to trigger this when the DB is open and secondly I then want to populate a table with AD users from a specific group.

Thanks

 

[CJ_London]

what to you think it does? What is it supposed to do?

Have you tried it? and if so what happens?

If not tested yet, temporarily create a button and call it from the click event. You'll need to supply the two parameters

 

[vbaInet]

It looks like it should do what your title states, "Importing users from AD into a table". So like CJ_London you'll need to give it the two parameters which are the domain and the group you would like to get the users from, and in addition you will need to have created the ADUsers table.

Fyi: The i=i+1 is redundant. It doesn't seem to be doing anything.

 

[BlueIshDan]

Try this out for starting off with.
From an old project I was tinkering with.

Private Sub Form_Load()
    'Use ADO and LDAP to return all users in Active Directory
    Dim objRecordSet As Object
    Dim objCommand As Object
    Dim objConnection As Object
    
    Const ADS_SCOPE_SUBTREE = 2
    
    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand = CreateObject("ADODB.Command")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Open "Active Directory Provider"
    Set objCommand.ActiveConnection = objConnection
    
    objCommand.Properties("Page Size") = 1000
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
    objCommand.Properties("Sort On") = "displayname"
    
    objCommand.CommandText = _
        "SELECT GivenName, displayname FROM 'LDAP://OU=Users,OU=NB,OU=NA,OU=Fluor,DC=fdnet,DC=com' WHERE objectCategory='user'"

    Set objRecordSet = objCommand.Execute
    
    objRecordSet.MoveFirst

    With objRecordSet

        Do Until .EOF

            Debug.Print .Fields("Name") & " : " & .Fields("displayname")
            .MoveNext

        Loop
    
    End With

End Sub

 

[BlueIshDan]

Just set your LDAP Query to specify the group.

 

[BlueIshDan]

I also see that you're doing a TOP 1... Is all of this just an attempt to get the currently logged in user's name?

 

[vbaInet]

I also see that you're doing a TOP 1... Is all of this just an attempt to get the currently logged in user's name?

Probably just an attempt to speed up opening the recordset.

 

[BlueIshDan]

Probably just an attempt to speed up opening the recordset.

Oh ok good

 

[Galaxiom]

Just set your LDAP Query to specify the group.

It isn't that simple because group is a multivalued field so needs to be processed as an array.

I have been involved in several LDAP threads on this site. I think one of them included stuff about groups but I don't have time to look now.

Search the forum for my name and LDAP.

 

[shabbaranks]

It looks like it should do what your title states, "Importing users from AD into a table". So like CJ_London you'll need to give it the two parameters which are the domain and the group you would like to get the users from, and in addition you will need to have created the ADUsers table.

Fyi: The i=i+1 is redundant. It doesn't seem to be doing anything.

Thanks to you and everyone for helping me with this, I have created a button and it errors at

Set objRootDSE = GetObject("ldap://rootDSE")

Run-time error -2147467259 (80004005)
Automation error
Unspecified error

Not very descriptive is it?

Code is:

 Dim objGroup As Object
     Dim objRootDSE As Object
     Dim objNet As Object
     Dim strDomain As Variant
     Dim objUser As Object
     Dim db As DAO.Database
     Dim rs As DAO.Recordset
     Dim strSQL As String
     Dim strGroup As String
     Dim i As Integer
     
     strDomain = "Domain"
     strGroup = "users group"
     
    Set db = CurrentDb
     'Get one record just so we have a record set to add to.
     strSQL = "SELECT TOP 1 * FROM ADUsers"
     Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
    Set objNet = CreateObject("WScript.Network")
     Set objRootDSE = GetObject("[URL]ldap://rootDSE[/URL]")
     Set objGroup = GetObject("WinNT://" & strDomain & "/" & strGroup & ",group")
     For Each objUser In objGroup.Members
         i = i + 1
         With rs
             .AddNew
             !UserName = objUser.Name
             .Update
         End With
     Next
     Set rs = Nothing
     Set db = Nothing
     Set objGroup = Nothing
     Set objRootDSE = Nothing
     Set objNet = Nothing

 

[shabbaranks]

Try this out for starting off with.
From an old project I was tinkering with.

Private Sub Form_Load()
    'Use ADO and LDAP to return all users in Active Directory
    Dim objRecordSet As Object
    Dim objCommand As Object
    Dim objConnection As Object
 
    Const ADS_SCOPE_SUBTREE = 2
 
    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand = CreateObject("ADODB.Command")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Open "Active Directory Provider"
    Set objCommand.ActiveConnection = objConnection
 
    objCommand.Properties("Page Size") = 1000
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
    objCommand.Properties("Sort On") = "displayname"
 
    objCommand.CommandText = _
        "SELECT GivenName, displayname FROM 'LDAP://OU=Users,OU=NB,OU=NA,OU=Fluor,DC=fdnet,DC=com' WHERE objectCategory='user'"
 
    Set objRecordSet = objCommand.Execute
 
    objRecordSet.MoveFirst
 
    With objRecordSet
 
        Do Until .EOF
 
            Debug.Print .Fields("Name") & " : " & .Fields("displayname")
            .MoveNext
 
        Loop
 
    End With
 
End Sub

Hi,

this did exactly what I wanted - I was wondering can this be modified to work on security groups rather than members of an OU?

Thanks again

 

[Galaxiom]

can this be modified to work on security groups rather than members of an OU?

There is stuff about reading the array that holds the list of user's in a group on this thread.

 

[shabbaranks]

never ceases to amaze me how clever people are, also this link made me re-think my process. I didn't need to populate a table in the end just use the logged in username and pull the first and surname from it. Thanks again

 

[shabbaranks]

Just to open an old thread Im now trying to add additional AD fields into my form - some work but I cant get other to show, like Department or Description for example.

I thought if I add them to the query, in theory it should pull them through

Public Function UserFullName(Optional ByVal LoginName As String) As String
 
Const adCmdText = 1
 
Dim ADConn As Object
Dim ADCommand As Object
Dim ADUser As Object
Dim DomainDN As String
 
If LoginName = vbNullString Then
    LoginName = CreateObject("wscript.network").UserName
End If
 
DomainDN = CreateObject("[URL]ldap://rootDSE").Get("defaultNamingContext[/URL]")
 
Set ADConn = CreateObject("ADODB.Connection")
    With ADConn
        .Provider = "ADsDSOObject"
        .Open "Active Directory Provider"
    End With
 
Set ADCommand = CreateObject("ADODB.Command")
    With ADCommand
        .ActiveConnection = ADConn
        .CommandType = adCmdText
        .CommandText = "SELECT givenName, division, SN, CN FROM 'LDAP://" & DomainDN & "' WHERE objectCategory='User' AND sAMAccountName ='" & LoginName & "'"
    End With
 
Set ADUser = ADCommand.Execute
 
    With ADUser
        UserFullName = !givenName & " " & !SN
    [B][U]    UserDepartment = !division[/U][/B]
    End With
 
    ADConn.Close
 
Set ADConn = Nothing
Set ADCommand = Nothing
Set ADUser = Nothing
 
End Function

The attribute highlighted and underlined doesn't work - any ideas why?

Thanks

 

[Galaxiom]

The attribute highlighted and underlined doesn't work - any ideas why?

"Doesn't work" doesn't help much. What error is thrown?

 

[shabbaranks]

It didn't return the department, instad I opted for some different code which works fine - thanks.

Public Function AdUserInfo() As String
On Error GoTo ErrorHandler
Dim sysInfo As ADSystemInfo
Dim oUser As ActiveDs.IADsUser
Dim LName As String, FName As String
Dim LoginName As String
Dim UserDepartment As String
Set sysInfo = CreateObject("ADSystemInfo")
Set oUser = GetObject("LDAP://" & sysInfo.UserName & "")
 
Forms!Control_txtbx = oUser.Department
Set sysInfo = Nothing
Set oUser = Nothing
 
End Function

 

[Galaxiom]

It didn't return the department, instad I opted for some different code which works fine - thanks.

The original code you posted was querying division field instead of the department field.

Anyway the new LDAP query you posted is a concise way to return all the user information without having to specify the fields.