Just paste this code into any module and change the name of the module to cEmployee.
'----------------------------------------------------------------------
'
' Module Name: cEmployee
' Written By: C&D Programming Corp.
' Create Date: 3/99
' Copyright: Copyright 1999 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'
'
' Database for this class is located at
'
' http://www.codeoftheweek.com/issues/employeesample.mdb
'
'
' This is a sample of one method for building a class around a table.
' The advantage with this approach that we have not seen elsewhere is
' the use of the enumerator for the fields in the table. It allows
' you to use the Auto List Members option to automatically show the
' fields available in the class when you use the Value property.
'
' In a future issue we will show how to automatically generate this
' class source code using Visual Basic to make managing your tables
' very easy.
'
' NOTE: This class does not yet support adding new records. It is
' currently designed to manage existing records.
'
' This will also be covered in a future issue (most likely next week).
'
'----------------------------------------------------------------------
Option Explicit
Const TABLENAME = "Employee"
Const KEYFIELDNAME = "Employee ID"
Const CLASSNAME = "cEmployee"
'
' This would need to be derived from a particular table.
'
Public Enum enumEmployeeFields
empEmployeeID
empFirstName
empLastName
empUserName
empSocialSecurityNumber
empAddress1
empAddress2
empCity
empState
empZip
empDateAdded
empDateUpdated
End Enum
Private mDB As Database
Private mID As Long
Private mRS As Recordset
Private mcolFields As New Collection
Private Function FieldName(eFieldID As enumEmployeeFields) As String
Dim sField As String
Select Case eFieldID
Case empEmployeeID
sField = "Employee ID"
Case empFirstName
sField = "First Name"
Case empLastName
sField = "Last Name"
Case empUserName
sField = "UserName"
Case empSocialSecurityNumber
sField = "Social Security Number"
Case empAddress1
sField = "Address 1"
Case empAddress2
sField = "Address 2"
Case empCity
sField = "City"
Case empState
sField = "State"
Case empZip
sField = "Zip"
Case empDateAdded
sField = "Date Added"
Case empDateUpdated
sField = "Date Updated"
Case Else
sField = ""
End Select
FieldName = sField
End Function
'
' This property allows you to set the Database object directly with an already opened
' database.
'
Public Property Set DatabaseObject(db As Variant)
Set mDB = db
End Property
'
' This property allows you to set the Database object by passing the name of the database
' to open. You should only use this if you only plan on using this object once.
'
Public Property Let DatabaseObject(db As Variant)
If TypeName(db) = "String" Then
Set mDB = DBEngine.OpenDatabase(db)
Else
Err.Raise 5, CLASSNAME & ".DatabaseObject", "Must specify the name of the database to open."
End If
End Property
Public Property Get DatabaseObject() As Database
Set DatabaseObject = mDB
End Property
Public Sub LoadFields(lID As Long)
Dim fld As Field
Set mRS = mDB.OpenRecordset("select * from " & TABLENAME & " where [" & KEYFIELDNAME & "] = " & lID, dbOpenSnapshot)
If mRS.RecordCount = 0 Then
Set mRS = Nothing
mID = -1 ' invalid id field
Err.Raise 53, CLASSNAME & ".LoadFields", "Could not find the record for " & KEYFIELDNAME & " " & lID
Else
ClearFields
For Each fld In mRS.Fields
mcolFields.Add fld.Value, fld.Name
Next
mRS.Close
mID = lID
End If
End Sub
Public Property Get Value(eFieldID As enumEmployeeFields) As Variant
If mcolFields.Count = 0 Then
Err.Raise 5, CLASSNAME & ".Value", "You must use one of the LoadFields functions before using the Value property."
Else
Value = mcolFields.Item(FieldName(eFieldID))
End If
End Property
Public Property Let Value(eFieldID As enumEmployeeFields, vValue As Variant)
If mcolFields.Count = 0 Then
Err.Raise 5, CLASSNAME & ".Value", "You must use one of the LoadFields functions before using the Value property."
Else
' remove the old value from the collection and add the new one
On Error GoTo Handler
mcolFields.Remove FieldName(eFieldID)
mcolFields.Add vValue, FieldName(eFieldID)
End If
Exit Property
Handler:
Err.Raise Err.Number, CLASSNAME & ".Value", "Could not replace field information. Error is " & Err.Description
End Property
Public Sub SaveFields()
Dim fld As Field
If mcolFields.Count = 0 Then
Err.Raise 5, CLASSNAME & ".Value", "You must use the LoadFields functions before using the SaveFields method."
Else
Set mRS = mDB.OpenRecordset("select * from " & TABLENAME & " where [" & KEYFIELDNAME & "] = " & mcolFields.Item(FieldName(empEmployeeID)), dbOpenDynaset)
mRS.Edit
For Each fld In mRS.Fields
' if updatable and not an auto increment field then save the value
If ((fld.Attributes And dbUpdatableField) <> 0) And ((fld.Attributes And dbAutoIncrField) = 0) Then
fld.Value = mcolFields.Item(fld.Name)
End If
Next
mRS.Update
mRS.Close
End If
End Sub
Private Sub ClearFields()
Dim x As Long
For x = mcolFields.Count To 1 Step -1
mcolFields.Remove x
Next
End Sub