Generate class from table

The ability to generate a class from a table is useful for all situations in Access where data sources can’t 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 UserForm Builder is started from the Code VBA menu:

table contacts

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

Generated code characteristics are:

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 VariantAs 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 StringAs Variant
    Dim strTrimmed As String: strTrimmed = Trim(str)
    If Len(strTrimmed) = 0 Then
        NullIfEmptyString = Null
    Else
        NullIfEmptyString = strTrimmed
    End If
End Function