MS 访问 VBA .additem 到列表框下标超出范围错误

Question

尝试根据组合框中的选择向列表框添加值时出现错误。过滤器(？我为记录集添加并没有告诉 lngRows 在应用过滤器后仅使用这些项目，而不是我认为是我问题的一部分。添加时出错，它将值放在框中，然后由于添加空格而出错。有没有办法解决这个问题？

Private Sub Combo5_AfterUpdate()
Set lb = Me.lbSA.Object
Dim varSelection() As Variant
Dim i As Long
lngRows = CurrentDb.TableDefs("tblSA").RecordCount
varSelection = CurrentDb.OpenRecordset("SELECT PROJ_ID,ShipArea FROM tblSA WHERE PROJ_ID = '" & Me.Combo5.Column(1) & "'").GetRows(lngRows)
For i = 0 To lngRows - 1
Me.lbSA.AddItem (varSelection(0, i)) 'error is here
Me.lbSA.Column(1, i) = varSelection(1, i)
Next
End Sub

Answer 1

不需要数组或列表框对象：

Private Sub Combo5_AfterUpdate()
Dim varSelection As Recordset
Set varSelection = CurrentDb.OpenRecordset("SELECT PROJ_ID, ShipArea FROM tblSA WHERE PROJ_ID = '" & Me.Combo5.Column(1) & "'")
While Not varSelection.EOF
Me.lbSA.AddItem varSelection(0), 0
varSelection.MoveNext
Wend
End Sub

或者只设置 RowSource 属性。确保"行源类型"属性设置为"表/查询"。

Private Sub Combo5_AfterUpdate()
Me.lbSA.RowSource = "SELECT PROJ_ID, ShipArea FROM tblSA WHERE PROJ_ID = '" & Me.Combo5.Column(1) & "'")
End Sub