Confused by acLBInitialize for specifying Col data 1

[tgikristi]

I have found numerous examples, both in books and online, of using callback functions to populate a listbox, but all the examples I have come across (that I understand) are for ONE column listboxes...I am VERY stumped (expecially by the acLBInitialize part) how to make this function work for a 2 column listbox...

What I am trying to do is make a listbox that shows each user in cat.Users and then in the next column, the corresponding Group that the user belongs to (each user only belongs to one group).

My code is as follows and I appreciate any insight anyone may have!!! Thanx!!!


Function FillUsersGroupsList(ctl As Control, id As Variant, col As Variant, _
row As Variant, Code As Variant) As Variant

Static intRows As Integer
Dim varRetVal As Variant
Dim cat As ADOX.Catalog
Dim usr As ADOX.User
Dim grp As ADOX.Group
Set ctl = Me.List34
Static sastrUsers() As String
Static sastrGroups() As String

Select Case Code
Case acLBInitialize
Set cat = New ADOX.Catalog
cat.ActiveConnection = CurrentProject.Connection

For Each usr In cat.Users
sastrUsers(intRows) = usr.Name 'this gives me a subscript error
intRows = intRows + 1
Next usr

'do I need a similar section for sastrGroups?
'how to indicate to create a list of each user (column 1) then user's group (column2) in each row?


varRetVal = intRows
Case acLBOpen
varRetVal = Timer
Case acLBGetRowCount
varRetVal = intRows
Case acLBGetColumnCount
varRetVal = 2
Case acLBGetColumnWidth
Select Case col
Case 0:
varRetVal = -1
Case 1:
varRetVal = -1
End Select
Case acLBGetValue
Select Case row
Case 0
Select Case col
Case 0
varRetVal = "User"
Case 1
varRetVal = "Access Group"
End Select
Case Else
Select Case col
Case 0
varRetVal = sastrUsers(row)
Case 1
varRetVal = sastrGroups(col)
End Select
End Select
End Select
FillUsersGroupsList = varRetVal
End Function

 

[cmmrfrds]

To start with the subscript error is due to not dimensioning the array. Example

The following statement resizes the array but does not erase elements.
Redim Preserve MyArray(15,2) ' Resize 15 rows, 2 columns.

Unless you know the size to start with you will need to redim each time through the loop to add a new user/group. The columns will always be 2 so, only the 1st dimension needs to be changed.

By the time you get to acLDGetValue you should only need to return the row from the array you built.

returnval = MyArray(row)

the acLBInitialize part will be used 1 time to build an array of rows and columns. i.e. user group or group user what ever you want in the listbox. subsequent calls to the function by access will pull each row from the array.

I will post a function in another post you can modify to build the array.

 

[cmmrfrds]

Paste this function into a module and run it. Notice it has 2 loops, one to get each user and then an inner loop to find each group the user belongs to. You should be able to use this as the basis for loading your array in the alLBInitialize.

Function JetSecurity2()
'-- set reference to ADOX library
'- Microsoft ADO Ext. 2.6 for DDL and Security
'-- Microsoft ActiveX data objects 2.6 library also needed for ADO

Dim cg As New ADOX.Catalog
Set cg.ActiveConnection = CurrentProject.Connection

Dim ur As User, gp As Group
For Each ur In cg.Users
Debug.Print "Users = "; ur.Name

For Each gp In ur.Groups
Debug.Print " Group = "; gp.Name

Next
Next
End Function

 

[cmmrfrds]

Loading the array will probably be something like this.

Dim ur As User, gp As Group
Dim myarray (1,1) as variant
Dim row as integer, col as integer
row =1
col =1
For Each ur In cg.Users
myarray(row,1) = ur.Name
For Each gp In ur.Groups
'- assumes 1 group per user, otherwise only last gp
myarray(row,2) = gp.Name
Next
row = row +1
Redim Preserve MyArray(row,2)
Next

 

[cmmrfrds]

Scrap what I showed on loading the array, it won't work. I tested and this will work.

Dim ur As User, gp As Group
Dim myarray() As Variant
Dim row As Integer, rowcount As Integer
'-- set the row count
rowcount = cg.Users.Count
'-- array is 0 based.
row = 0
ReDim Preserve myarray(rowcount, 2)
For Each ur In cg.Users
myarray(row, 1) = ur.Name
For Each gp In ur.Groups
'- assumes 1 group per user, otherwise only last gp
myarray(row, 2) = gp.Name
Next
row = row + 1
If row = rowcount Then Exit For
Next
For row = 0 To rowcount - 1
Debug.Print myarray(row, 1); ", "; myarray(row, 2)
Next

 

[cmmrfrds]

Okay, here is the function. It was tested and works for 1 group per user. If more groups are needed a slight mod to the array in the inner loop will take care of it.

Function UserGroupList(fld As Control, ID As Variant, _
rowX As Variant, col As Variant, _
code As Variant) As Variant
Dim ur As User, gp As Group
Static myarray() As Variant
Static row As Integer, rowcount As Integer
Dim cg As New ADOX.Catalog

Dim ReturnVal As Variant
ReturnVal = Null

Select Case code
Case acLBInitialize ' Initialize.
Set cg.ActiveConnection = CurrentProject.Connection
rowcount = cg.Users.Count
row = 0
ReDim Preserve myarray(rowcount, 2)
For Each ur In cg.Users
myarray(row, 0) = ur.Name
For Each gp In ur.Groups
myarray(row, 1) = gp.Name
Next
row = row + 1
If row = rowcount Then Exit For
Next
ReturnVal = rowcount

Case acLBOpen ' Open.
' Generate unique ID for control.
ReturnVal = Timer
Case acLBGetRowCount ' Get number of rows.
ReturnVal = rowcount
Case acLBGetColumnCount ' Get number of columns.
ReturnVal = 2
Case acLBGetColumnWidth ' Column width.
' -1 forces use of default width.
ReturnVal = -1

Case acLBGetValue ' Get data.
'-- zero based array
Select Case col
Case 0
ReturnVal = myarray(rowX, 0)
Case 1
ReturnVal = myarray(rowX, 1)
End Select
Debug.Print "column = "; col

Case acLBEnd ' End.
Erase myarray
End Select
'''''Debug.Print "return value = "; ReturnVal
UserGroupList = ReturnVal
End Function

 

[tgikristi]

Thank you so much cmmrfrds--you and your code are so awesome and I really appreciate your effort!! Works great! I was pretty sure it had something to do with arrays--another thing I need to add to my list of 'things to learn'.

 

[cmmrfrds]

Thank you, I am glad it worked for you.

Buy the way, the code under acLBGetValue can reduce to.
Case acLBGetValue ' Get data.
ReturnVal = myarray(rowX, col)