Excel VBA - Workaround LDAP administrative limits

Question

In a UserForm I've got multiple listboxes.

A list of all Groups in the Active Directory (AD);
A list of selected Groups from ListBox1;
A list of unique members (hence the use of a dictionary since some users can be a member of multiple groups) of these selected groups;

I'm at the point where the first and second lists work fine, however I'm hitting the LDAP administrative limit when the query will return over 1000 records which will return a run-time error 'error -2147016669'. It's this exact problem for reference. Anything below a 1000 and the code will run smooth.

I'm moving in unfamiliar territory and I'm unable to find the correct way to implement the "Page Size" property so that the full list of users will populate the initialized dictionary:

Private Sub Button1_Click()

Set rootDSE = GetObject("LDAP://rootDSE")
domainDN = rootDSE.Get("defaultNamingContext")
Set ado = CreateObject("ADODB.Connection")
ado.Provider = "ADSDSOObject"
ado.Open "ADSearch"

Set Dict_members = CreateObject("Scripting.Dictionary")
For n = 0 To ListBox2.ListCount - 1
    If Me.ListBox2.Selected(n) = True Then
        ldapFilter = "(sAMAccountName=" & Me.ListBox2.List(n) & ")"
        Set objectList = ado.Execute("<LDAP://" & domainDN & ">;" & ldapFilter & ";distinguishedName,primaryGroupToken;subtree")
        groupDN = objectList.Fields("distinguishedName")
        groupRID = objectList.Fields("primaryGroupToken")
        ldapFilter = "(|(memberOf=" & groupDN & ")(primaryGroupID=" & groupRID & "))"
        Set objectList = ado.Execute("<LDAP://" & domainDN & ">;" & ldapFilter & ";distinguishedName,samAccountName,displayname,userPrincipalName;subtree")
        While Not objectList.EOF
            On Error Resume Next
                If Not IsNull(objectList.Fields("userPrincipalName")) Then
                    Dict_members(objectList.Fields("userPrincipalName").Value) = 1
                End If
                'logonNameUPN = objectList.Fields("userPrincipalName")
            On Error GoTo 0
            objectList.MoveNext
        Wend
        objectList.Close
    End If
Next

ado.Close
Me.ListBox3.List = Dict_members.Keys
Me.Label6.Caption = Dict_members.Count

End Sub

I guess the idea is to 'loop' in batches of 1000. Any help is appreciated.

From what I can tell from the link (in the link you've given), is to set it after `ado.Open` given that you've added a command object. `Set objCommand = CreateObject("ADODB.Command")` and `objCommand.ActiveConnection = ado` needed before `objCommand.Properties("Page Size") = 1000`. Or do you mean, you don't know how to figure out the actual limit instead of 1000? — Notus_Panda, Dec 09 '22 at 15:22
@Notus_Panda, the problem is twofold, I don't know how/where to apply this property *and* I actually don't want to leave any members from the result so I suppose some loop is needed. I can access my project sometime this weekend again to try and fiddle. — JvdV, Dec 09 '22 at 16:02
This might help: http://www.selfadsi.org/search.htm#PagedResults — Gabriel Luci, Dec 10 '22 at 00:45
Bounty added but shortly after got to an answer myself. Apologies. — JvdV, Dec 12 '22 at 13:53

score 7 · Accepted Answer · answered Dec 12 '22 at 13:52

I got it working now; granted I don't know exactly why:

Private Sub Label5_Click()

Set rootDSE = GetObject("LDAP://rootDSE")
domainDN = rootDSE.Get("defaultNamingContext")
Set ado = CreateObject("ADODB.Connection")
ado.Open "Provider=ADsDSOObject;"
Set AdoCmd = CreateObject("ADODB.Command")
AdoCmd.ActiveConnection = ado
AdoCmd.Properties("Page Size") = 1000

Set Dict_members = CreateObject("Scripting.Dictionary")
For n = 0 To ListBox2.ListCount - 1
    If Me.ListBox2.Selected(n) = True Then
        ldapFilter = "(sAMAccountName=" & Me.ListBox2.List(n) & ")"
        AdoCmd.CommandText = "<LDAP://" & domainDN & ">;" & ldapFilter & ";distinguishedName,primaryGroupToken;subtree"
        Set objectList = AdoCmd.Execute
        groupDN = objectList.Fields("distinguishedName")
        groupRID = objectList.Fields("primaryGroupToken")
        ldapFilter = "(|(memberOf=" & groupDN & ")(primaryGroupID=" & groupRID & "))"
        AdoCmd.CommandText = "<LDAP://" & domainDN & ">;" & ldapFilter & ";distinguishedName,samAccountName,displayname,userPrincipalName;subtree"
        Set objectList = AdoCmd.Execute
        While Not objectList.EOF
            On Error Resume Next
                If Not IsNull(objectList.Fields("userPrincipalName")) Then
                    Dict_members(objectList.Fields("userPrincipalName").Value) = 1
                End If
            On Error GoTo 0
            objectList.MoveNext
        Wend
        objectList.Close
    End If
Next

ado.Close
Me.ListBox3.List = Dict_members.Keys
Me.Label6.Caption = Dict_members.Count

End Sub

So what is different to the code I initially had used is:

ado.Open "Provider=ADsDSOObject;" instead of ado.Open "ADSearch";
The 'ADODB.Command' to be able to use and set properties. In order to execute properly I also had to initialize the AdoCmd.CommandText, and then execute.

For some reason a more direct:

Set objectList = AdoCmd.Execute("<LDAP://" & domainDN & ">;" & ldapFilter & ";distinguishedName,primaryGroupToken;subtree")

Would yield an error.

This is the result of some trial and error, but it works flawlessly now and will return thousands and thousands of users if need be.

score 6 · Answer 2 · answered Dec 12 '22 at 21:13

6

You may be working too hard with this code. If it were me, I'd pull back all the columns I wanted from Active Directory using Power Query and then just use normal Excel table and Pivot operations.

Data > Get Data > From Other Sources > From Active Directory

answered Dec 12 '22 at 21:13

TheRizza

1,577
1
10
23

Very usefull. I'll dive into this, thanks for the suggestion. + – JvdV Dec 13 '22 at 09:17
1

I don't work with Active Directory much, but if you get stuck on the Power Query side I can help there. For me, the hardest part of this is knowing which path to take to find data. If you already know what you are looking for in AD, it's not that hard. You'll see a lot of columns with "Record". You can preview the data by clicking in the whitespace to the right of "Record". Click the 2 arrow icon in the header to expand all the records in the column. You may have to do that multiple times down a particular path. There are some crazy bits, but you'll find good examples on this site. – TheRizza Dec 13 '22 at 17:31
I used to pull all security groups first through VBA (costly since it took about 15 minutes for 70000 groups), with automating a refresh on a connection to "Query - Group" it takes just under a minute or so. Then selecting different groups by a user and returning members through LDAP in vba was still flawless and fast. I haven't tried to pull this through PQ since I indeed seen it takes quite a few steps. For now I got my product running, and I'll play around a bit more with PQ in a shadowfile. I guess I could say I'm currently using best of both worlds =) – JvdV Dec 14 '22 at 07:26
2

I have awarded you the bounty. Though not an answer to the problem, this has really helped cut down processing time on the front-end of my application where I pull in all security groups from AD. Thanks again for the recommendation. – JvdV Dec 19 '22 at 12:10

Excel VBA - Workaround LDAP administrative limits

2 Answers2