Problems regarding OpenRecordset

[JohanJ]

Can someone please help me to find the errors in my code. I've used the following code:

Private Function AddAllToList(C As Control, Id As Long, Row As _Long, Col As Long, Code As Integer) As Variant

Static DB As DAO.Database, RS As DAO.Recordset
Dim PRm As Parameter
Dim Qdf As QueryDef


' Open the recordset defined in the RowSource property.
Set DB = DBEngine.Workspaces(0).Databases(0)
Set Qdf = DB.QueryDefs(C.RowSource)

For Each PRm In Qdf.Parameters
PRm.Value = Eval(PRm.Name)
Next PRm
Set RS = Qdf.OpenRecordset(dbOpenSnapshot)

The Rowsource property is set to:

SELECT [qryFilt_Markets].Idnummer, [qryFilt_Markets].Markets FROM _[qryFilt_Markets]

Unfortunately I get a Error message that says:
Item not found in collection!

Hopefully somenone knows why this error occurs

Thanks in advance!

 

[Mile-O]

It might be helpful if you can say at which line you get the error.

 

[JohanJ]

Actually I don't know! This error occurs when I open the form containing the combobox.

The thing is that I have used the function AddAllToList from microsoft's support and tried to modify the code to work with a query as rowsource instead of a table.

Before the modifications I got an Error message that sayd:
Too few parameters. Expected 3.

However, I found code at this forum how to get rid of this error and now I get the following error:

Item not found in this collection

I paste the hole code below in case that it makes it easier!

 

[JohanJ]

Forgot the code!!

Private Function AddAllToList(C As Control, Id As Long, Row As Long, Col As Long, Code As Integer) As Variant

'*************************************************
'**************
' FUNCTION: AddAllToList()
'
' PURPOSE:
' Adds "(all)" as the first row of a combo box or list box.
'
' USAGE:
' 1. Create a combo box or list box that displays the data you
' want.
'
' 2. Change the RowSourceType property from "Table/Query" to
' "AddAllToList."
'
' 3. Set the value of the combo box or list box's Tag property to
' the column number in which you want "(all)" to appear.
'
' NOTE: Following the column number in the Tag property, you can
' enter a semicolon ( and then any text you want to appear
' other than the default "all."
'
' For example
'
' Tag: 2;<None>
'
' displays "<None>" in the second column of the list.
'
'*************************************************
'**************
Static DB As DAO.Database, RS As DAO.Recordset
Static DISPLAYID As Long
Static DISPLAYCOL As Integer
Static DISPLAYTEXT As String
Dim Semicolon As Integer
Dim PRm As Parameter
Dim Qdf As QueryDef

On Error GoTo Err_AddAllToList

Select Case Code
Case LB_INITIALIZE
' See if the function is already in use.
If DISPLAYID <> 0 Then
MsgBox "AddAllToList is already in use by another Control! """
AddAllToList = False
Exit Function
End If

' Parse the display column and display text from the Tag
' property.
DISPLAYCOL = 1
DISPLAYTEXT = "(All markets)"
If Not IsNull(C.Tag) Then
Semicolon = InStr(C.Tag, ";")
If Semicolon = 0 Then
DISPLAYCOL = Val(C.Tag)
Else
DISPLAYCOL = Val(Left(C.Tag, Semicolon - 1))
DISPLAYTEXT = Mid(C.Tag, Semicolon + 1)
End If
End If

' Open the recordset defined in the RowSource property.
Set DB = DBEngine.Workspaces(0).Databases(0)
Set Qdf = DB.QueryDefs(C.RowSource)

For Each PRm In Qdf.Parameters
PRm.Value = Eval(PRm.Name)
Next PRm
Set RS = Qdf.OpenRecordset(dbOpenSnapshot)

' Record and return the ID for this function.
DISPLAYID = Timer
AddAllToList = DISPLAYID

Case LB_OPEN
AddAllToList = DISPLAYID

Case LB_GETROWCOUNT
' Return the number of rows in the recordset.
RS.MoveLast
AddAllToList = RS.RecordCount + 1

Case LB_GETCOLUMNCOUNT
' Return the number of fields (columns) in the recordset.
AddAllToList = RS.Fields.Count

Case LB_GETCOLUMNWIDTH
AddAllToList = -1

Case LB_GETVALUE
' Are you requesting the first row?
If Row = 0 Then
' Should the column display "(All)"?
If Col = DISPLAYCOL - 1 Then
' If so, return "(All)."
AddAllToList = DISPLAYTEXT
Else
' Otherwise, return NULL.
AddAllToList = Null
End If
Else
' Grab the record and field for the specified row/column.
RS.MoveFirst
RS.Move Row - 1
AddAllToList = RS(Col)
End If
Case LB_END
DISPLAYID = 0
RS.Close
End Select

Bye_AddAllToList:
Exit Function

Err_AddAllToList:
Beep: MsgBox Error$, 16, "AddAllToList"
AddAllToList = False
Resume Bye_AddAllToList
End Function

 

[simongallop]

If you are using acc2k or greater then make sure that you have DAO3.6 library loaded. (In the module window, toolbar Tools / References)

 

[JohanJ]

I use Access 2002 and DAO 3.6 object library is loaded.

Thanks anyway!