-
I am tring to debug someone else's code and they are using checkboxes in a listbox that is populated from a database. The code loops and fills the listbox and goes back around and if the item already exists it is suppose to put a check next to the item.
For some reason it will not work. It generates Error 381 (Invalid property array index). I think the guy is trying to make the index number of the item the same as the id in the database to determine what item is what in the listbox.
Here is a piece of the code below:
Code:
Do While Not rsData.EOF
With lstRiskFactors
.AddItem rsData.Field("id_desc")
.ItemData(.NewIndex) = rsData.Fields("id")
If Not IsNull(rsData.Fields("id_riskFactor")) Then
.Selected(rsData.Fields("id_riskFactor") - 1) = True
End If
End With
rsData.MoveNext
Loop
rsData.Close
-
If he's storing the ID in each Items ItemData property you should be searching the List for an ItemData value that matches id_riskFactor, i.e.
Code:
Do While Not rsData.EOF
With lstRiskFactors
.AddItem rsData.Field("id_desc")
.ItemData(.NewIndex) = rsData.Fields("id")
If Not IsNull(rsData.Fields("id_riskFactor")) Then
For lIndex = 0 To .ListCount
If .ItemData(lIndex) = rsData.Fields("id_riskFactor") Then Exit For
Next
If lIndex <= .ListCount Then .Selected(lIndex) = True
End If
End With
rsData.MoveNext
Loop
rsData.Close
-
<?>
Code:
Option Explicit
'uses a datacontrol called Data1
'uses listbox called List1
'set the style of listbox to 1 - Checked
'uses a database called yourdatabase with a field called yourfield
'and a table called yourtable
'
'open database and set database and recordset
Public cdbName As String, ctblName As String
Public Sub OpenDB()
Dim AppPath$
If Right(App.Path, 1) <> "\" Then _
AppPath = App.Path & "\" _
Else AppPath = App.Path
cdbName = AppPath & "YourDatabase.mdb"
ctblName = "YourTable"
Data1.DatabaseName = cdbName
Data1.RecordSource = ctblName
End Sub
Private Sub Command1_Click()
'datacontrol is Data1, fieldname is yourfiled
Do While Not Data1.Recordset.EOF
With List1
.AddItem Data1.Recordset!yourfield
If Not IsNull(Data1.Recordset.Fields("yourfield")) Then
.Selected(Data1.Recordset.Fields("yourfield") - 1) = True
End If
End With
Data1.Recordset.MoveNext
Loop
End Sub
Private Sub Form_Load()
'
Call OpenDB
'
Set db = Workspaces(0).OpenDatabase(cdbName)
Set rs = db.OpenRecordset(ctblName)
End Sub