VB6 - EnumGroupMembers with more than 1000 members

Giganews Newsgroups
Subject: VB6 - EnumGroupMembers with more than 1000 members
Posted by:  T. Valen (newsgroup-tmp2007…@musikerREMOVETHIS.de)
Date: Wed, 17 Dec 2008

Hi!

I found that I can retrieve 1000 members of a group only. Can anybody
tell me how to retrieve _all_ members of a group?

Thanks in advance!

Regards,
T.

################################################

The code below is an excerpt of what I'm trying to do. The issue is:
    For Each objMember In objGroup.Members
which is incomplete when a group has more than 1000 members.

------------------------------------------------

Private Function EnumGroupMembers_new(ByVal strADSPath As String,
Optional Quiet As Boolean) As String

Dim objGroup, strDN, objMemberList
Dim adoConnection, adoCommand, objRootDSE, strDNSDomain
Dim Sekunde As Integer
Dim Zeichen As String

Set objMemberList = CreateObject("Scripting.Dictionary")
objMemberList.CompareMode = vbTextCompare

strDN = strADSPath
Set objGroup = GetObject("LDAP://" & strDN)
On Error GoTo 0

Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")

Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

Dim strFilter, strAttributes, strQuery, strNTName, strObjectClass,
strOffset As String

Dim adoRecordset, intGroupToken
Dim objMember
strOffset = "  "
    objGroup.GetInfoEx Array("primaryGroupToken"), 0
    intGroupToken = objGroup.Get("primaryGroupToken")
    strFilter = "(primaryGroupID=" & intGroupToken & ")"
    strAttributes = "sAMAccountName,objectCategory"
    strQuery = "<LDAP://" & strDNSDomain & ">;" & strFilter & ";" & _
          strAttributes & ";subtree"
    adoCommand.CommandText = strQuery
    Set adoRecordset = adoCommand.Execute

    Do Until adoRecordset.EOF
        strNTName = LCase(adoRecordset.Fields("sAMAccountName").Value)
        strObjectClass = adoRecordset.Fields("objectCategory").Value

        If (objMemberList.Exists(strNTName) = False) Then
            Select Case UCase(Left(strObjectClass, 8))
            '[...]
            End Select
            objMemberList.Add strNTName, True
        End If
        adoRecordset.MoveNext
    Loop
    adoRecordset.Close

    For Each objMember In objGroup.Members
        If (objMemberList.Exists(objMember.samaccountname) = False) Then
            strNTName = objMember.samaccountname
            Select Case UCase(Left(objMember.objectCategory, 8))
        ' [...]
            End Select
            objMemberList.Add strNTName, True
        End If
    Next

    Set objMember = Nothing
    Set adoRecordset = Nothing

adoConnection.Close
Set objGroup = Nothing
Set objRootDSE = Nothing
Set adoCommand = Nothing
Set adoConnection = Nothing

End Function

Replies