Importing users from AD into a table

S

shabbaranks

Registered User.
Local time
Today, 13:45
Joined
Oct 17, 2011
Messages
300
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.

Code: 
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
 
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
 
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.
 
Try this out for starting off with. :)
From an old project I was tinkering with.

Code: 
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
 
Last edited:
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?
 
BlueIshDan said:
Just set your LDAP Query to specify the group.
Click to expand...

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.
 
vbaInet said:
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.
Click to expand...


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:
Code: 
 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
 
BlueIshDan said:
Try this out for starting off with. :)
From an old project I was tinkering with.

Code: 
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
Click to expand...


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
 
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 :)
 
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

Code: 
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
 
It didn't return the department, instad I opted for some different code which works fine - thanks.

Code: 
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
 
shabbaranks said:
It didn't return the department, instad I opted for some different code which works fine - thanks.
Click to expand...

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.
 
You must log in or register to reply here.

Similar threads

N
Solved Failing To Save Imported Data from the internet in Ms Access
Replies
6
Views
408
nector
N
N
How to ensure the open recordset include also any new record entered
Replies
9
Views
523
nector
N
A
Match two numbers and then update
Replies
10
Views
505
Gasman
Gasman
A
Restrictions Update Message
Replies
17
Views
634
Gasman
Gasman
N
VBA MS Access Error Handling
Replies
5
Views
605
Pat Hartman
P

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom