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
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 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.