For a combo or list box, the source data is normally a Table/Query. Or it could be a value list, a static list of data.
But what if your information is not held in a table, and it is not a static list.
Examples I have used have been, “next 100 prime numbers after this one”, “Every third Friday from start of next month”, “All tables in my database that start “tlk”, “All users in the MDW file” and many other lists that are a calculated or derived function.
There is another type of row source type for combo and list boxes and that is using a global recursive function that is structured in a specific way.
This function will return a single column of data, calculated by a global function.
In order to use this, you need first to create your combo or list box, say cboLookup on your form.
Leave the RowSourceType as Table/Query but don’t assign a RowSource.
In the on-open event of the form, assign the RowSourceType of your box to your global function. (The function must be in a standard module, not in the form's module)
Expand|Select|Wrap|Line Numbers
- cboLookup.RowSourceType = "ListLookup"
Expand|Select|Wrap|Line Numbers
- Function ListLookup(fld As Control, id, row, col, Code) As Variant
- ' Author Mark Fisher
- ' Description
- ' Returns a function list of all lookup tables, up to a max of 100
- ' Note, this can't go in a form, it must be global!!!
- On Error GoTo Err_ListLookup
- Static astrTables(100) As String, entries As Integer
- Dim returnval As Variant
- Dim i As Integer, j As Integer
- Dim db As Database
- Dim intCount As Integer
- returnval = Null
- Select Case Code
- Case 0
- Set db = CurrentDb
- intCount = 0
- For i = 0 To db.Containers.Count - 1
- If db.Containers(i).Name = "Tables" Then
- For j = 0 To db.Containers(i).Documents.Count - 1
- If Left(db.Containers(i).Documents(j).Name, "3") = "tlk" Then
- If db.Containers(i).Documents(j).Name = "tlkText" Or db.Containers(i).Documents(j).Name = "tlkTranslate" Then
- 'do nowt
- Else
- astrTables(intCount) = db.Containers(i).Documents(j).Name
- intCount = intCount + 1
- End If
- End If
- Next
- End If
- Next
- entries = intCount
- Set db = Nothing
- returnval = entries
- Case 1
- returnval = Timer
- Case 3
- returnval = entries
- Case 4, 5
- returnval = -1
- Case 6
- returnval = astrTables(row)
- Case 9
- For entries = 0 To 100
- astrTables(entries) = ""
- Next
- End Select
- ListLookup = returnval
- Exit_ListLookup:
- Exit Function
- Err_ListLookup:
- If Not Err Then
- MsgBox "Contact Support" & vbCrLf & "Error " & Err & " in ListLookup " & vbCrLf & Error$, _
- 16, "Error in Global Module"
- Resume Exit_ListLookup
- End If
- End Function
- You must use the calling parameters as shown, i.e. fld As Control, id, row, col, Code.
- You need an array to store the list results, I use astrTables(). This must be a static array (which persists after the function exits) and must be large enough to hold your maximum entries.
- All the structure of the case statement must be retained, like I said, I have never seen this documented so it took trial and error to get it working from a magazine example yonks ago.
- This function is called many times, with different values of Code, and no, I don’t know what does the calling, I just know it works.
Case 9 is the initialization. This is where you empty your array
Case 6 is where you return the rowth value of your array
Case 3 returns the count of entries to be displayed
Case 0 is where you design your function to make up your list. In this case, I loop through the table container, looking for tablenames I want, and adding them to the list, increasing the count along the way.
I have no idea what the other cases do, I leave them alone and the function works.
Here is another listfunction that returns all the users in the MDW file that belong to my ‘staff’ group
Expand|Select|Wrap|Line Numbers
- Function ListUsers(fld As Control, id, row, col, Code)
- ' Author Mark Fisher
- ' Description
- ' Returns a function list of all users, up to a max of 300
- ' Note, this can't go in a form, it must be global!!!
- '
- On Error GoTo Err_ListUsers
- Static astrUserNames(300) As String, entries As Integer
- Dim returnval
- Dim wks As Workspace
- Dim usr As User, intGrp As Integer, onlystaff As Boolean, isStaff As Boolean, intCount As Integer
- returnval = Null
- Select Case Code
- Case 0
- Set wks = DBEngine.CreateWorkspace("", SECUREUSER, SECUREPASSWORD)
- intCount = 0
- For entries = 0 To wks.Users.Count - 1
- isStaff = False
- onlystaff = True
- Set usr = wks.Users(entries)
- For intGrp = 0 To usr.Groups.Count - 1
- If usr.Groups(intGrp).Name = "Staff" Then
- isStaff = True
- ElseIf usr.Groups(intGrp).Name = "Users" Then
- 'ignore it
- Else
- onlystaff = False
- End If
- Next intGrp
- If isStaff And onlystaff Then
- astrUserNames(intCount) = wks.Users(entries).Name
- intCount = intCount + 1
- End If
- Next entries
- entries = intCount
- Set usr = Nothing
- wks.Close
- Set wks = Nothing
- returnval = entries
- Case 1
- returnval = Timer
- Case 3
- returnval = entries
- Case 4, 5
- returnval = -1
- Case 6
- returnval = astrUserNames(row)
- Case 9
- For entries = 0 To 300
- astrUserNames(entries) = ""
- Next
- End Select
- ListUsers = returnval
- Exit_ListUsers:
- Exit Function
- Err_ListUsers:
- If Not Err Then
- MsgBox "Contact Support" & vbCrLf & "Error " & Err & " in ListUsers " & vbCrLf & Error$, _
- 16, "Error in Global Module"
- Resume Exit_ListUsers
- End Select
- End Function