Access 2007 using Active directory for domain groups

Not sure exactly what you are looking for but here's a sample function that returns all users from an AD group.  I use it in vbs to output a list of users to a text file so you'll see some commented code to that effect.  I modified it into VBA - you'll see a note to add the MS Scripting Runtime library.

OM Gang

Public Function TestADGroups()
On Error GoTo Err_TestADGroups
 
    Dim objGroup As Object, objUser As Object, objFSO As Object
    Dim objFile As Object, RootDSE As Object, objConnection As Object
    Dim objCommand As Object
    Dim objRecordset As ADODB.Recordset
    Dim strDomain As String, strGroup As String
    Dim strUserName As String, strSearchRoot As String
    Dim strQueryText As String, strFName As String, strLName As String
    
        'Change DomainName to the name of the domain the group is in
    strDomain = "ADDomainName"
        'Change GroupName to the name of the group whose members you want to export
    strGroup = "ADGroupName"
        'set reference to 'Microsoft Scripting Runtime'
    Set objFSO = CreateObject("Scripting.FileSystemObject")
        'On the next line change the name and path of the file that export data will be written to.
    'Set objFile = objFSO.CreateTextFile("C:\temp\GroupOutput.txt")
    Set objGroup = GetObject("WinNT://" & strDomain & "/" & strGroup & ",group")
    For Each objUser In objGroup.Members
        strUserName = objUser.name
 
        Set RootDSE = GetObject("LDAP://RootDSE")
        strSearchRoot = RootDSE.Get("defaultNamingContext")
 
        Set objConnection = CreateObject("ADODB.Connection")
        Set objCommand = CreateObject("ADODB.Command")
        objConnection.Provider = "ADsDSOObject"
        objConnection.Open "Active Directory Provider"
        Set objCommand.ActiveConnection = objConnection
 
        strQueryText = "<LDAP://" & strSearchRoot & ">;(&(objectCategory=Person)(samAccountName=" & strUserName & "));" _
            & "givenName,sn,ADsPath;SubTree"
        objCommand.CommandText = strQueryText
        objCommand.Properties("Page Size") = 2000
        objCommand.Properties("Timeout") = 60
        objCommand.Properties("Cache Results") = False
        Set objRecordset = objCommand.Execute
        If Not objRecordset.EOF Then
            objRecordset.MoveFirst
 
            ' --- Loop through the returned records
            Do Until objRecordset.EOF
                strFName = Nz(objRecordset.Fields("givenName").Value, "")
                strLName = Nz(objRecordset.Fields("sn").Value, "")
                'MsgBox strFName & " " & strLName, 0, "Test"
                objRecordset.MoveNext
            Loop
 
            'objFile.WriteLine strFName & " " & strLName
            Debug.Print strFName & " " & strLName
        End If
    Next
    
Exit_TestADGroups:
    'objFile.Close
    Set objRecordset = Nothing
    Set objCommand = Nothing
    Set objConnection = Nothing
    Set RootDSE = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing
    Set objUser = Nothing
    Set objGroup = Nothing
    Exit Function
    
Err_TestADGroups:
    MsgBox Err.Number & ", " & Err.Description, , "Error"
    Resume Exit_TestADGroups
    
End Function

Select allOpen in new window

Thanks for that but I get a runtime error.  I have added the MS Scripting Runtime library.  Screen shot attached.  I'm calling the function from the imediate window.  This would work for me if I could feed it the username and group.  I am right is saying I could change the function to accept ther two variables?

Thanks
Error.doc

You need a reference to the ADO library - in my Access 2003 setup it's
Microsoft ActiveX Data Objects 2.1 Library

To pass the variables to the function do this - I am assuming you want to pass the domain name and the group

Public Function TestADGroups(strDomain As String, strGroup As String)
On Error GoTo Err_TestADGroups
 
    Dim objGroup As Object, objUser As Object, objFSO As Object
    Dim objFile As Object, RootDSE As Object, objConnection As Object
    Dim objCommand As Object
    Dim objRecordset As ADODB.Recordset
    'Dim strDomain As String, strGroup As String
    Dim strUserName As String, strSearchRoot As String
    Dim strQueryText As String, strFName As String, strLName As String

If you want to pass the username and retrun all group memberships for that user, like in one of the links you provided, you'll need to make minor modification to the code.

OM Gang

What I'm really trying to do is give it the username and group so I can set up a menu dependant on what group the user is in.

I now get this error, Automation error The network path was not found.
Error.doc

On what line is this error occuring?
OM Gang

It doesn't say an error line or stop on a row.  It just shows the pop up wondow.  See screen shoot.  Thanks in advance for all your help.
Error.doc

This is a screen shot of my current references
references.doc

Put a break-point in your code, like on
strDomain = "....."
Now when you call the function the code will stop on that line and allow you to step through the code one line at a time.
OM Gang

I have added what I think is a breakpoint, I'm then pushing f5 to continue.  It stops first time at the break point then goes to the msg box?  See the screen shot attached to last comment.

In the VB editor, click the View menu and then Toolbars.  Click to show the debug toolbar.  On this toolbar you have some buttons for stepping through the code.

Launch your function.  When the code breaks at the break-point you have inserted, click the 'Step Into' toolbar button to step through the code line-by-line.  Move your mouse pointer over the toolbar buttons to see which one is 'Step Into'

OM Gang

Okay, it stops at
strGroup = "joebyrne"
 Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objGroup = GetObject("WinNT://" & strDomain & "/" & strGroup & ",group")
    MsgBox Err.Number & ", " & Err.Description, , "Error"

Then I get the error msg box?

Is 'joebyrne' really the name of one of your AD groups?  Looks like a user to me.

Try this one out instead.   I just tested it and it works for what you want
OM Gang

Public Function TestADGroups2(strUserName As String)
On Error GoTo Err_TestADGroups2
  
    Dim objUser As Object, objGroup As Object
    Dim RootDSE As Object
    Dim strSearchRoot As String
    Dim colGroups As Object
 
    Set RootDSE = GetObject("LDAP://RootDSE")
    strSearchRoot = RootDSE.Get("defaultNamingContext")
 
    Set objUser = GetObject("LDAP://CN=" & strUserName & ",OU=OUName," & strSearchRoot)
    Set colGroups = objUser.Groups
    For Each objGroup In colGroups
        Debug.Print objGroup.CN
    Next
    
Exit_TestADGroups2:
    Set RootDSE = Nothing
    Set objGroup = Nothing
    Set colGroups = Nothing
    Set objUser = Nothing
    Exit Function
    
Err_TestADGroups2:
    MsgBox Err.Number & ", " & Err.Description, , "Error"
    Resume Exit_TestADGroups2
    
End Function

Select allOpen in new window

Sorry that was my mistake but I still get an error.  See attached screen shot.  Am I doing it correctly by using the imediate window to check.  


screen-shot.doc

You left OU=OUName in the code.  You need to change that to whatever the name of the OU is, or names of the OU's are, in your situation, i.e. in my environment it's something like

Set objUser = GetObject("LDAP://CN=" & strUserName & ",OU=Users,OU=Accounting," & strSearchRoot)

OM Gang

you need what's called the DN, or distinguished name, of the AD object you want to bind to
Set objUser = GetObject("LDAP://CN=OM Gang,OU=Users,OU=Puter Fixers,DC=SillyDomain,DC=com)
This refers to the user object OM Gang
in the container (organizational unit) Users
in the container (organizational unit) Puter Fixers
in the domain SillyDomain.com

OM Gang

obviously, in my sample code, strUserName is used to pass the user name and strSearchRoot passes the DC entries.
OM Gang

Sorry I am still missing something, I have a OU called SBSUsers, a domain called jbit.local and a user called joebyrne.  See screen shot again, it says object does not exist.
screen-shot.doc

thanks :)