Problem:
Reading records from the database and instead of using DLookup or querying the database all the time, to improve performance we can read them into a VBA collection object and refer to it in memory. Especially, if the data in particular tables are not changing at all or changing very rarely, we can use this facility and hold the data in memory while the application is running. Beware of the number of records in your table and the amount of memory it may consume.

First, a very simple table to hold our data, with an ID (primary key) field to store unique numbers and a simple character field to save alphanumeric data.

Then, based on our table, a VBA class definition to store and manipulate data in memory.

'clsTable1
Option Compare Database
Option Explicit

'definition same as Table1
Public id As Long
Public data As String

'Flag to be set TRUE when loaded fine
Public isOK As Boolean

Private Sub Class_Initialize()
    isOK = False
    id = 0
    data = ""
End Sub

Initialization of collection with simple/random record objects

Getting records from simple collection

Initialization of collection with records objects from Table1

Getting record objects from the collection

Here is the code of module modMain:

'modMain
Option Compare Database
Option Explicit

'simple collection
Private myColl_simple As Collection

'collection to hold records of Table1 by id's
Private myColl As Collection

Function myColl_init() As Boolean
On Error GoTo myErr
    Dim rs As DAO.Recordset, sKey As String, r As clsTable1
    Set myColl = New Collection
    Set rs = CurrentDb.OpenRecordset("table1")
    rs.MoveFirst
    Do While Not rs.BOF And Not rs.EOF
        Set r = New clsTable1
        r.id = rs.Fields("id").Value
        r.data = rs.Fields("data").Value
        r.isOK = True
        sKey = "A" & r.id
        myColl.Add r, sKey
        rs.MoveNext
    Loop
    rs.Close: Set rs = Nothing
myExit:
    myColl_init = (myColl.Count > 0)
    Exit Function
myErr:
    Resume myExit
End Function

Function myColl_get_simple(i As Long) As String
On Error GoTo myErr
    Dim k As String, v As String, r As clsTable1
    k = "A" & i 'key
    Set r = myColl_simple.Item(k)
    v = r.data
myExit:
    myColl_get_simple = v
    Exit Function
myErr:
    v = "" 'return an unexpected value
    Resume myExit
End Function

Function myColl_get(i As Long) As clsTable1
On Error GoTo myErr
    Dim k As String, r As clsTable1
    k = "A" & i 'key
    Set r = myColl.Item(k) 'Flag is fine already
myExit:
    Set myColl_get = r
    Exit Function
myErr:
    Set r = New clsTable1 'return an object, flag False
    Resume myExit
End Function

Function myColl_init_simple() As Boolean
    Dim i As Long, k As String, v As String, t As clsTable1
    Set myColl_simple = New Collection
    Randomize
    For i = 1 To 26
        v = Chr(64 + i) 'A .. Z
        v = v & v & v  ' AAA .. ZZZ
        Set t = New clsTable1
        t.id = i
        t.data = v
        t.isOK = True
        k = "A" & i ' key
        myColl_simple.Add t, k
    Next i
    myColl_init_simple = (myColl_simple.Count > 0)
End Function

Code run when loading the form

Putting all the code in use

Putting all the code in use (runtime)

Putting all the code in use

Putting all the code in use (runtime)

Code of the form frmTest:

'frmTest
Option Compare Database
Option Explicit

Private Sub cmdGet_Click()
Dim id As Long, r As clsTable1
    id = CLng(Nz(Me.txtID, 0))
    If id > 0 Then
        Set r = myColl_get(id)
        If r.isOK Then
            Me.txtData.Value = r.data
        End If
    End If
End Sub

Private Sub cmdGetSimple_Click()
Dim id As Long, v As String
    id = CLng(Nz(Me.txtID, 0))
    If id > 0 Then
        v = myColl_get_simple(id)
        If v <> "" Then
            Me.txtData.Value = v
        End If
    End If
End Sub


Private Sub Form_Load()
    If Not myColl_init_simple() Then
        MsgBox "Error loading records!"
    End If
    If Not myColl_init() Then
        MsgBox "Error loading records!"
    End If
End Sub

Feel free to download the whole database.

Tags: ,
Categories: