[AccessD] ...collections guru?

William Hindman wdhindman at dejpolsystems.com
Mon Feb 15 14:00:34 CST 2010


...no, I'm not looking for a bill collector :)

...I'm running the following code behind a form.
...the code in InitialzeData runs just fine, no errors, and the displays 
work.
...the code in InitializeData2 gives an error every time on the line
Rose1.AddButton cName(i), "12," & cPolygon(i)
...the difference is of course that one uses a txt file to initialize the 
collections and the other uses an Access table with the same data
...the nCount in InitializeData2 shows 3 records read as it should
...the error is "Runtime error 3420. Object Invalid or No Longer Set"
...I'm a virgin in trying to code collections ...looking for a guru to tell 
me what I'm doing wrong ;)

William
--------------------------------------------
Option Compare Database
Option Explicit

    Dim cPolygon As New Collection
    Dim cName As New Collection
    Dim cStatusbar As New Collection
    Dim cLabel As New Collection


Private Sub Form_Load()

    Dim i As Integer

    '-----
    'Initialize data
    'InitializeData
    InitializeData2

    '-----Add hotspot buttons to map and display
    Rose1.BitmapPath = GetAppPath()
    'Rose1.SetCustomColorPalette "map_ncal.bmp"
    Rose1.Wallpaper = "MBCC_Hall_C_Spring_001.bmp"
    'Rose1.Wallpaper = "map_ncal.bmp"
    Rose1.StartForm "Form1"
        For i = 1 To cName.Count
            Rose1.AddButton cName(i), "12," & cPolygon(i)
            Rose1.SetButtonStatusbar "", cStatusbar(i)
            Rose1.SetButtonLabel "", cLabel(i)
        Next
    Rose1.EndForm
    Rose1.OpenForm "Form1"


End Sub

Private Sub Form_Unload(Cancel As Integer)

    '-----Clear up
    Set cPolygon = Nothing
    Set cName = Nothing
    Set cStatusbar = Nothing
    Set cLabel = Nothing

End Sub

Private Function GetAppPath() As String
    'Working variables
    Dim sAppPath As String
    Dim i As Integer, nLen As Integer, nPos As Integer

    sAppPath = Application.DBEngine.Workspaces(0).Databases(0).Name
    nLen = Len(sAppPath)
    For i = 1 To nLen
        If Mid(sAppPath, nLen - i, 1) = "\" Then
            nPos = nLen - i
            Exit For
        End If
    Next
    sAppPath = Left(sAppPath, nPos - 1)
    GetAppPath = sAppPath

End Function

Private Sub InitializeData()


    '-----Hotspot Polygon Data
    cPolygon.Add "0238, 75,61,18,18, 75 61 92 61 92 78 75 78 75 61 75 61 92 
61"
    cPolygon.Add "0239, 113,61,18,18, 113 61 130 61 130 78 113 78 113 61"
    cPolygon.Add "1333, 733,137,18,17, 750 137 750 153 733 153 733 137"

    '-----Hotspot button names
    cName.Add "0238"
    cName.Add "0239"
    cName.Add "1333"

    '-----Hotspot status bar text
    cStatusbar.Add "Booth 0238"
    cStatusbar.Add "Booth 0239"
    cStatusbar.Add "Booth 1333"


    '-----Hotspot button labels
    cLabel.Add "0238"
    cLabel.Add "0239"
    cLabel.Add "1333"

End Sub
Private Sub InitializeData2()

    Dim i As Integer, nCount As Integer
    Dim dbs As DAO.Database, rst As DAO.Recordset
    Dim strSQL As String

    '-----Get data from table
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("tblFloorPlans")
    'strSQL = "SELECT [ID], [RegionName], [Statusbar], [Label], [Polygon] 
FROM tblFloorPlans;"
    'Set rst = dbs.OpenRecordset(strSQL)
    rst.MoveLast
    nCount = rst.RecordCount
    'If nCount > 0 Then
      'MsgBox nCount, vbInformation
    'End If
    rst.MoveFirst

    '-----Fill data to collections
    For i = 1 To nCount
        cName.Add rst!RegionName
        cStatusbar.Add rst!Statusbar
        cLabel.Add rst!Label
        cPolygon.Add rst!Polygon
        rst.MoveNext
    Next

    '-----Close
    rst.Close
    Set dbs = Nothing 





More information about the AccessD mailing list