Programming to query 100000 users in AD

Question

I am currently working on a project to query AD, I have a script that do that, but the script is failing after 1000 users, while the users I am querying is around 150.000 users.

Here is my code:

below is my script , can you tell me on which line

Sub UserSynchQuery(ByRef res As APIResult, ByRef oRespDS As APIDataSet, ByRef sLDAPServer As String, ByRef sLDAPPort As String, ByRef sLDAPBase As String, ByRef sUserName As String, ByRef sPassword As String, ByRef sSLPPrimary As String, ByRef sSLPSecondary As String, ByRef sExtension As String, ByRef sConfiggroup As String, ByRef sFilter As String )

Trace( "Called UserSynchQuery Entered" )

Dim oDSP As Object
Dim oDSRS As Object

On Error Resume Next
Set oDSP = CreateObject("ADODB.Connection") 
oDSP.Provider = "ADSDSOObject" 

oDSP.Open( "Ads Provider", sUserName, Demung( sPassword ))  

If Err.Number <> 0 Then
        Trace("ERROR: Failed to instantiate ADO Object. " & Err.Number & " " & Err.Description)
        res.Code = "FAILED"
        res.Reason = "Failed to instantiate ADO Object"
        Exit Sub
End If

On Error Goto 0

    Dim sRoot      'Holds the root of the LDAP object
    sRoot = "LDAP://" & sLDAPServer & ":" & sLDAPPort & "/" & sLDAPBase

Dim sQuery As String
Dim sSelect As String

sSelect = ADS_COLUMN_DN & "," & ADS_COLUMN_USERNAME & "," & ADS_COLUMN_LASTNAME & "," & ADS_COLUMN_FIRSTNAME & "," & ADS_COLUMN_EMAIL & ","

If Len(sSLPPrimary) > 0 Then
    sSelect = sSelect & sSLPPrimary & ","
End If
If Len(sSLPSecondary) > 0 Then
    sSelect = sSelect & sSLPSecondary & ","
End If
If Len(sExtension) > 0 Then
    sSelect = sSelect & sExtension & ","
End If
If Len(sConfiggroup) > 0 Then
    sSelect = sSelect & sConfiggroup & ","
End If

sSelect = sSelect & ADS_COLUMN_MEMBEROF

sQuery = "SELECT " & sSelect & " FROM '" & sRoot & "' WHERE " & sFilter

Trace( "Query String: " & sQuery )

On Error Resume Next
Set oDSRS = oDSP.Execute(sQuery)  

If Err.Number <> 0 Then
        Trace("ERROR: Query Failed. " & Err.Number & " " & Err.Description)
        res.Code = "FAILED"
        res.Reason = "Query Failed"
        Exit Sub
End If

On Error Goto 0

'// before you can fill in the dataset, you must initialize it with the 
'// number of columns
oRespDS.Initialize(MSG_USER_QUERY_RESP_NUM_COLS)


    Dim nRow
    Dim sRSUserName
    Dim sRSLastName
    Dim sRSFirstName
    Dim sRSEmail
    Dim sRSDN
    Dim sRSSLPPrimary
    Dim sRSSLPSecondary
    Dim sRSExtension
    Dim sRSConfiggroup

    nRow = 0

    Do Until oDSRS.EOF

    sRSUserName = oDSRS.Fields(ADS_COLUMN_USERNAME).Value
    sRSLastName = oDSRS.Fields(ADS_COLUMN_LASTNAME).Value
    sRSFirstName = oDSRS.Fields(ADS_COLUMN_FIRSTNAME).Value
    sRSEmail = oDSRS.Fields(ADS_COLUMN_EMAIL).Value
    sRSDN = oDSRS.Fields(ADS_COLUMN_DN).Value


    Trace("----------- Found User -----------")
    Trace("Username: " & sRSUserName)
    Trace("Last Name: " & sRSLastName)
    Trace("First Name: " & sRSFirstName)
    Trace("Email: " & sRSEmail)
    Trace("DN: " & sRSDN)
    If Len(sSLPPrimary) > 0 Then
        sRSSLPPrimary = oDSRS.Fields(sSLPPrimary).Value
        Trace("sSLPPrimary: " & sRSSLPPrimary)
    End If
    If Len(sSLPSecondary) > 0 Then
        sRSSLPSecondary = oDSRS.Fields(sSLPSecondary).Value
        Trace("sSLPSecondary: " & sRSSLPSecondary)
    End If
    If Len(sExtension) > 0 Then
        sRSExtension = oDSRS.Fields(sExtension).Value
        Trace("sExtension: " & sRSExtension)
    End If
    If Len(sConfiggroup) > 0 Then
        sRSConfiggroup = oDSRS.Fields(sConfiggroup).Value
        Trace("sConfiggroup: " & sRSConfiggroup)
    End If

    If( IsNull( sRSUserNamme ) Or IsNull( sRSLastName ) Or IsNull( sRSFirstName ) Or IsNull( sRSDN ) ) Then
        Trace( "Error: Ignoring user due to missing information" )
    Else
        'We need to build up the list of groups which needs
        'to include any indirect group membership which could
        'be the result of assigning a group to be a member of
        'another group.

        Dim arrGroups
        Dim dictGroupNamesByDN

        Set dictGroupNamesByDN = CreateObject("Scripting.Dictionary")

        arrGroups = oDSRS.Fields(ADS_COLUMN_MEMBEROF).Value

        if IsNull( arrGroups )  Then
            Trace("--->No groups found")
        Else
            ProcessGroupMembership( dictGroupNamesByDN, arrGroups )             
        End If



        'Now assing the roles to the user based on
        'the nested groups that we just retrieved.

        Dim sApplications As String
        sApplications = ""

        'We also use this opportunity to build the
        'workgroup membership up.

        Dim sWorkgroup As String
        sWorkgroups = ""

        Dim sCN As String
        Dim sDN As String

        Dim keys
        keys = dictGroupNamesByDN.Keys

        For Each key in keys
            sDN = key
            sCN = dictGroupNamesByDN.Item(key)

            sWorkgroups = sWorkgroups & sCN & ";"

            If sCN = CIM_AGENT_APPLICATION_GROUP_NAME Then
                sApplications = sApplications & "AGENT;"
            End If

            If sCN = CIM_RESMAN_APPLICATION_GROUP_NAME Then
                sApplications = sApplications & "RESMAN;"
            End If

            If sCN = CIM_CONFIGMAN_APPLICATION_GROUP_NAME Then
                sApplications = sApplications & "CONMAN;"
            End If

            If sCN = CIM_IVAULT_APPLICATION_GROUP_NAME Then
                sApplications = sApplications & "IVAULT;"
            End If

            If sCN = CIM_DECMAN_APPLICATION_GROUP_NAME Then
                sApplications = sApplications & "DMWEB;"
            End If

            If sCN = CIM_QIM_APPLICATION_GROUP_NAME Then
                sApplications = sApplications & "QIM;"
            End If

            If sCN = CIM_SYSMAN_APPLICATION_GROUP_NAME Then
                sApplications = sApplications & "SYSMAN;"
            End If
        Next


        Trace("Roles: " & sApplications)
        Trace("Workgroups: " & sWorkgroups)


        oRespDS.AddRow
        oRespDS.SetField(nRow,MSG_USER_QUERY_RESP_USERNAME, sRSUserName)
        oRespDS.SetField(nRow,MSG_USER_QUERY_RESP_LASTNAME, sRSLastName)
        oRespDS.SetField(nRow,MSG_USER_QUERY_RESP_FIRSTNAME, sRSFirstName)

        If Not IsNull(sRSEMail) Then
            oRespDS.SetField(nRow,MSG_USER_QUERY_RESP_EMAIL, sRSEmail)
        End If

        oRespDS.SetField(nRow,MSG_USER_QUERY_RESP_DN, sRSDN)
        oRespDS.SetField(nRow,MSG_USER_QUERY_RESP_APPLICATIONS, sApplications)
        oRespDS.SetField(nRow,MSG_USER_QUERY_RESP_WORKGROUPS, sWorkgroups)

        If Len(sSLPPrimary) > 0 Then
            If IsNull( sRSSLPPrimary ) Then
                Trace("Warning: " & sSLPPrimary & " value not populated")
            Else
                oRespDS.SetField(nRow,MSG_USER_QUERY_RESP_SLPPRIMARY, sRSSLPPrimary)
            End If
        End If

        If Len(sSLPSecondary) > 0 Then
            If IsNull( sRSSLPSecondary ) Then
                Trace("Warning: " & sSLPSecondary & " value not populated")
            Else
                oRespDS.SetField(nRow,MSG_USER_QUERY_RESP_SLPSECONDARY, sRSSLPSecondary)
            End If
        End If

        If Len(sExtension) > 0 Then
            If IsNull( sRSExtension ) Then
                Trace("Warning: " & sExtension & " value not populated")
            Else
                oRespDS.SetField(nRow,MSG_USER_QUERY_RESP_EXTENSION, sRSExtension)
            End If
        End If

        If Len(sConfiggroup) > 0 Then
            If IsNull( sRSConfiggroup ) Then
                Trace("Warning: " & sConfiggroup & " value not populated")
            Else
                oRespDS.SetField(nRow,MSG_USER_QUERY_RESP_CONFIGGROUPS, sRSConfiggroup)
            End If
        End If

        nRow = nRow + 1
    End If

    oDSRS.MoveNext
    Loop


    'Clean up
On Error Resume Next

    oDSP = Nothing
    oDSRS = Nothing

    On Error Goto 0
End Sub

The variable of LDAP SERVER, LDAP PORT, Username, Password and search base for both user and group is entered via application and it is working so far.

Error what I have is once it reaches 1000 users:

The size limit for this request was exceeded.

If I removed the line oDSRS.MoveNext it would give an "Overflow" error.

I did some reading and this is the closest I could come up with.

Way too much code to wade through. Which function call gives the error message? Have you checked the documentation to see if there are published limits? — Jim Mischel, Jul 25 '16 at 18:25
hello , my apology for the long code, but i just want to be clear on what i am trying to achieve — JohnsME, Jul 25 '16 at 19:58
this is the part where it is not working Sub UserSynchQuery, i read something objCommand.Properties("Page Size") = 1000, but it gives me this error ": The size limit for this request was exceeded." and I then I removed the line oDSRS.MoveNext and now i am getting this error "Overflow." — JohnsME, Jul 25 '16 at 20:02
i am trying this ( i did look before asking :) ) http://www.computing.net/answers/programming/do-until-eof-will-not-finish/28417.html, it is giving me another error — JohnsME, Jul 25 '16 at 20:07
The code you posted is obviously neither C# nor VBScript. Are you really trying to do this in VBA (MS Office)? Also, 700 LoC? Seriously? Please reduce that wall of code of yours to an [mvce]. Also do **not** post additional information as comments. **Edit** your question. — Ansgar Wiechers, Jul 25 '16 at 20:21
Telling us that it fails somewhere in your `UserSynchQuery` method is not very helpful. Use your debugger to single-step and identify the *exact* line that triggers the error. If it's a function call, tell us what parameters you're passing to the function. Edit your question to add that information. Don't put it in comments. Remember, all we know about your problem is what you tell us. And right now you're not telling us nearly enough for us to help you out. — Jim Mischel, Jul 25 '16 at 20:25
I edited it, I post it that so it is make sense to eveyrbody, apology for the problem caused — JohnsME, Jul 25 '16 at 20:36
Again, your code is **not** VBScript. Is it VBA? VB6? VB.net? — Ansgar Wiechers, Jul 25 '16 at 21:44
i try to use this line objCommand.Properties("Page Size") = 1000, but it is giving me an error variable type — JohnsME, Jul 26 '16 at 01:14

score 1 · Answer 1 · answered Jul 26 '16 at 15:30

1

The LDAP administrative limits balance Active Directory operational capabilities and performance. These limits prevent specific operations from adversely affecting the performance of the server. The limits also make the server resilient to denial of service attacks.

As a part of the limits there is a MaxPageSize setting that controls the number of records that can be returned for an LDAP query. The default number is 1,000 records and if you have more than that, you will get an error “The size limit for this request was exceeded”.

To workaround, set the Page Size option, that instructs the domain controller to process a certain number of records and return them to the client before continuing the search.

objCommand.Properties("Page Size") = 1000

where objCommand is a name of your Command object.

See complete example here.

answered Jul 26 '16 at 15:30

user2316116

6,726
1
21
35

HI , I applied the bjCommand.Properties("Page Size") = 1000 just before this line Dim sRoot 'Holds the root of the LDAP object sRoot = "LDAP://" & sLDAPServer & ":" & sLDAPPort & "/" & sLDAPBase – JohnsME Jul 27 '16 at 21:01
but it still gving me an error The size limit for this request was exceeded on this line oDSRS.MoveNext Loop 'Clean up On Error Resume Next – JohnsME Jul 27 '16 at 21:02
I saw the link , can you tell me where should i put the line Command.Properties("Page Size") = 1000? – JohnsME Jul 27 '16 at 23:23
Please provide the complete code. The given example above is irrelevant to the search. Also please see other similar topics, e.g. http://stackoverflow.com/questions/12217066/directoryentry-page-size-limit – user2316116 Jul 28 '16 at 07:22
can I dm you the code ? because it has close to 1000 lines and I uploaded the orginal one and everybody is not happy to say the least – JohnsME Jul 28 '16 at 15:59

Programming to query 100000 users in AD

1 Answers1

Linked