Generate class from table

The ability to generate a class from a table is useful for all situations in Access where data sources cannot be managed directly by binding them to a form. Example uses:

  1. a table which is to contain general system parameters (an alternative to using custom properties)
  2. add and remove items, and current quantity needs to be flexibly managed, e.g. Inventory control

The Class Builder is started from the Code VBA menu:

Alt-CC | Menu: Code VBA » Class » Create Class for Table » [table]
table contacts

As an example this creates for the above table Contacts the code below

Generated code characteristics are:

  • Each table field is interpreted as a class property
  • Recordset managed - created and terminated - within the class
  • Find record: using FindFirst automatically picks up the records values in class private variables
  • FindFirst without argument is interpreted as move and load the first record. This is useful for parameter tables with only one record.
  • Update saves the current value of the class' properties back into the record
  • Create new record: use AddNew. AddNew tells the class that Update should be interpreted as creating a new record
Notes
  • A better name for the class is Contact instead of the generated name Contacts. You can change this in the Property Window.
  • Function NullIfEmptyString is added to insert a Null value instead of an empty string in case the type of the field is String and the Required property is set to False.
  • Property ID only has a Get statement as this property is type autonumber

Three ways to use the generated class

The generated class can be used in three ways:

  1. Read values from the selected record
  2. Add new record
  3. Update selected record

Read values from the selected record

In the code below Pete's LastName is printed to the Debug Window.


Dim clsContact As Contact
Set clsContact = New Contact
With clsContact
.FindFirst "FirstName='Pete'"
Debug.Print .LastName
End With

Add new record

Here a new record is added.


Dim clsContact As Contact
Set clsContact = New Contact
With clsContact
.AddNew
.FirstName = "Frank"
.LastName = "Delano"
.Score = 1
.BirthDate = #1/5/1955#
.Update
End With

Update selected record

In the code below Pete's score is update to 15.


Dim clsContact As Contact
Set clsContact = New Contact
With clsContact
.FindFirst "FirstName='Pete'"
.Score = 15
.Update
End With

Generated code for class Contact


Private mdtBirthDate As Date
Private mstrEmailAddress As String
Private mstrFirstName As String
Private mlngID As Long
Private mstrLastName As String
Private miScore As Integer
Private mrstRecordset As Recordset
Private mbooLoaded As Boolean
Public Property Get BirthDate() As Date
BirthDate = mdtBirthDate
End Property

Public Property Let BirthDate(rData As Date)
mdtBirthDate = rData
End Property

Public Property Get EmailAddress() As String
EmailAddress = mstrEmailAddress
End Property

Public Property Let EmailAddress(rData As String)
mstrEmailAddress = rData
End Property

Public Property Get FirstName() As String
FirstName = mstrFirstName
End Property

Public Property Let FirstName(rData As String)
mstrFirstName = rData
End Property

Public Property Get ID() As Long
ID = mlngID
End Property

Public Property Get LastName() As String
LastName = mstrLastName
End Property

Public Property Let LastName(rData As String)
mstrLastName = rData
End Property

Public Property Get Score() As Integer
Score = miScore
End Property

Public Property Let Score(rData As Integer)
miScore = rData
End Property

Private Property Get Recordset() As Recordset
Set Recordset = mrstRecordset
End Property

Private Property Set Recordset(rData As Recordset)
Set mrstRecordset = rData
End Property

Private Sub Load()
With Recordset
Me.BirthDate = Nz(.Fields("BirthDate").Value)
Me.EmailAddress = Nz(.Fields("EmailAddress").Value)
Me.FirstName = Nz(.Fields("FirstName").Value)
mlngID = Nz(.Fields("ID").Value)
Me.LastName = Nz(.Fields("LastName").Value)
Me.Score = Nz(.Fields("Score").Value)
End With
mbooLoaded = True
End Sub

Public Sub Update()
With Recordset
If mbooLoaded = True Then
.Edit
Else
.AddNew
End If
.Fields("BirthDate").Value = Me.BirthDate
.Fields("EmailAddress").Value = NullIfEmptyString(Me.EmailAddress)
.Fields("FirstName").Value = NullIfEmptyString(Me.FirstName)
mlngID = Nz(.Fields("ID").Value)
.Fields("LastName").Value = NullIfEmptyString(Me.LastName)
.Fields("Score").Value = Me.Score
.Update
End With
mbooLoaded = True
End Sub

Public Sub AddNew()
mbooLoaded = False
End Sub

Public Function FindFirst(Optional Criteria As Variant) As Boolean
If IsMissing(Criteria) Then
Recordset.MoveFirst
FindFirst = Not Recordset.EOF
Else
Recordset.FindFirst Criteria
FindFirst = Not Recordset.NoMatch
End If
If FindFirst Then Load
End Function

Private Sub Class_Initialize()
Set Recordset = CurrentDb.OpenRecordset("Contacts", dbOpenDynaset)
End Sub

Private Sub Class_Terminate()
Recordset.Close
Set Recordset = Nothing
End Sub

Function NullIfEmptyString(str As String) As Variant
Dim strTrimmed As String: strTrimmed = Trim(str)
If Len(strTrimmed) = 0 Then
NullIfEmptyString = Null
Else
NullIfEmptyString = strTrimmed
End If
End Function