Source code for Issue Number 93

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. 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

Code of the Week Home


Source Code

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