Creating collection woes

[PieterLinden via AccessMonster.com]

I'm using the code from Chapter 7 of ADH 2002 - the stuff that goes with the
MultiPik class. The form has two listboxes, which can be filled in several
different ways, and I am trying to use two collections. I can populate the
lstAvailable just fine... FWIW, here's the code...

Here's the code I'm using in the form:
Private Sub Form_Open(Cancel As Integer)
' Four steps to using Multipik:

' 1. Instantiate the object
' 2. Set up the RowSourceType for the list boxes.
' If you did this at design time, you needn't
' do it now.
' 3. Register the 8 controls with the object
' 4. Tell it where your data comes from
Dim colReportSections As New Collection
Set colReportSections = ReportSections
Set mmp = New MultiPik

mmp.RegisterControls _
lstAvailable, lstSelected, _
cmdAddOne, cmdAddAll, _
cmdDeleteOne, cmdDeleteAll, _
cmdUp, cmdDown
' Modify the following line to
' match your own needs.
' Specify a recordsource (table
' or query name) and a field to display.
'mmp.SetData "tblCompanies", "Company"

'error 3420: Object invalid or no longer set...
mmp.SetCollections RecordReturningQueries, colReportSections

lstAvailable.RowSourceType = "FillLists"
lstSelected.RowSourceType = "FillLists"

Set colReportSections = Nothing

Here are the ancillary functions that are being called:
the RecordReturningQueries function works fine, but the (should be ?!!)
second, ReportSections crashes on the line indicated above.

Option Compare Database
Option Explicit

Public Function RecordReturningQueries() As Collection
Dim colQ As Collection 'local collection to dump queries into
Dim intKey As Integer ' counter for collection's key.
Dim qdf As DAO.QueryDef

Set colQ = New Collection

For Each qdf In DBEngine(0)(0).QueryDefs
If (qdf.Type = dbQSelect Or qdf.Type = dbQCrosstab) And Left$(qdf.
Name, 1) <> "~" Then
colQ.Add Item:=qdf.Name, Key:=CStr(intKey)
intKey = intKey + 1
End If
Next qdf

Set RecordReturningQueries = colQ
Set colQ = Nothing

End Function

Public Function ReportSections() As Collection
Dim colSections As Collection
Dim intKey As Integer
Dim rs As DAO.Recordset

Set colSections = New Collection
Set rs = DBEngine(0)(0).OpenRecordset("SELECT ztblSections.SectionName
FROM ztblSections WHERE (((ztblSections.Include) = True)) ORDER BY
ztblSections.SectionName;", dbOpenForwardOnly)

Do Until rs.EOF
colSections.Add Item:=rs.Fields("SectionName"), Key:=CStr(intKey)
intKey = intKey + 1
rs.MoveNext
Loop

rs.Close
Set ReportSections = colSections
Set colSections = Nothing

End Function


I'm baffled... the code looks pretty much identical to me... at least where
the objects get added to the collections, but one works and one does not.
Any idea what I'm doing wrong and how to fix it?

Thanks,

Pieter

 

[Dirk Goldgar]

I'm using the code from Chapter 7 of ADH 2002 - the stuff that goes with
the
MultiPik class. The form has two listboxes, which can be filled in
several
different ways, and I am trying to use two collections. I can populate
the
lstAvailable just fine... FWIW, here's the code...

Here's the code I'm using in the form:
Private Sub Form_Open(Cancel As Integer)
' Four steps to using Multipik:

' 1. Instantiate the object
' 2. Set up the RowSourceType for the list boxes.
' If you did this at design time, you needn't
' do it now.
' 3. Register the 8 controls with the object
' 4. Tell it where your data comes from
Dim colReportSections As New Collection
Set colReportSections = ReportSections
Set mmp = New MultiPik

mmp.RegisterControls _
lstAvailable, lstSelected, _
cmdAddOne, cmdAddAll, _
cmdDeleteOne, cmdDeleteAll, _
cmdUp, cmdDown
' Modify the following line to
' match your own needs.
' Specify a recordsource (table
' or query name) and a field to display.
'mmp.SetData "tblCompanies", "Company"

'error 3420: Object invalid or no longer set...
mmp.SetCollections RecordReturningQueries, colReportSections

lstAvailable.RowSourceType = "FillLists"
lstSelected.RowSourceType = "FillLists"

Set colReportSections = Nothing

Here are the ancillary functions that are being called:
the RecordReturningQueries function works fine, but the (should be ?!!)
second, ReportSections crashes on the line indicated above.

Option Compare Database
Option Explicit

Public Function RecordReturningQueries() As Collection
Dim colQ As Collection 'local collection to dump queries into
Dim intKey As Integer ' counter for collection's key.
Dim qdf As DAO.QueryDef

Set colQ = New Collection

For Each qdf In DBEngine(0)(0).QueryDefs
If (qdf.Type = dbQSelect Or qdf.Type = dbQCrosstab) And Left$(qdf.
Name, 1) <> "~" Then
colQ.Add Item:=qdf.Name, Key:=CStr(intKey)
intKey = intKey + 1
End If
Next qdf

Set RecordReturningQueries = colQ
Set colQ = Nothing

End Function

Public Function ReportSections() As Collection
Dim colSections As Collection
Dim intKey As Integer
Dim rs As DAO.Recordset

Set colSections = New Collection
Set rs = DBEngine(0)(0).OpenRecordset("SELECT ztblSections.SectionName
FROM ztblSections WHERE (((ztblSections.Include) = True)) ORDER BY
ztblSections.SectionName;", dbOpenForwardOnly)

Do Until rs.EOF
colSections.Add Item:=rs.Fields("SectionName"), Key:=CStr(intKey)
intKey = intKey + 1
rs.MoveNext
Loop

rs.Close
Set ReportSections = colSections
Set colSections = Nothing

End Function


I'm baffled... the code looks pretty much identical to me... at least
where
the objects get added to the collections, but one works and one does not.
Any idea what I'm doing wrong and how to fix it?

I believe the problem is that you aren't adding the value of the field
[SectionName] to the collection; you are adding a reference to the field
object itself, and so it becomes invalid when the recordset is closed.
Change this line:

colSections.Add Item:=rs.Fields("SectionName"), Key:=CStr(intKey)

.... to this:

colSections.Add Item:=rs.Fields("SectionName").Value,
Key:=CStr(intKey)

 

[PieterLinden via AccessMonster.com]

Change this line:


... to this:

colSections.Add Item:=rs.Fields("SectionName").Value,
Key:=CStr(intKey)

That was it! Thanks, Dirk! Worked great.

Pieter