Using DAO (Data Access Objects) Code

 

Why Use Code Instead of the Data Control?

 

The advantage of using the data control is that you can put together solid data entry forms without writing much VB code.  This method works well for small, one-time projects that need to be completed quickly.

 

The disadvantage of using the data control is that once the project is completed, it is not always easy to modify the data entry form or adapt the finished form for another data entry project.  Also, forms built using the data control are not always easy to debug or maintain because most of the action goes on in the data control itself.  If you think your project needs to be modified or maintained by other programmers, the data control might not be your best choice.

 

The advantage of using complete VB code to produce data entry forms is that you have total control over all aspects of the process.  You decide when to open the database and recordset, and you control the read and write operations as well.  This capability can be a real advantage in multiuser (file-sharing) settings where increased traffic can cause locking conflicts in programs that use the data control.  Another advantage of using VB code for your data entry forms is that you can create generic code that you can reuse in all your database projects.  When you have a fully debugged set of data entry routines, you can quickly create new forms without much additional coding.  Because the form rely on generic routines, they are also easy to modify and maintain in the future.

 

The primary drawback for using VB code to create data entry forms is that you have to handle all processes yourself; you can assume nothing.  For example, locating and updating a single record in a data table requires that you account for all of the following processes:

·         Opening the database

·         Opening the recordset

·         Locating the requested record

·         Loading the input controls from the recordset

·         Handling all user actions during the data entry process

·         Writing the updated controls back to the recordset

You also need a way for the user to browse the data.  In giving up the data control, you give up its VCR-style navigation arrows.

 

Despite this added responsibility, writing your data entry forms with VB code gives you much greater control over the process and can result in a form that is easy for both programmers and users to deal with.  Even though you have to do a good bit of coding to create new data management routines, these routines can often be reused in future projects with a minimum of re-coding.

 

 

The Sample Database (EMPLOYEE.MDB)

 

This document shows you how to process an Access database using code alone. The database is named "EMPLOYEE.MDB", and is based on the sample employee file used in the tutorials on sequential files.

 

EMPLOYEE.MDB contains three tables: EmpMast, DeptMast, and JobMast.  The tables are structured as follows:

 

EmpMast table:

 

Field Name

DataType

Comments

EmpNbr

AutoNumber

Primary Key. Uniquely identifies each employee in the database.

EmpFirst

Text (50)

Employee's first name

EmpLast

Text (50)

Employee's last name

DeptNbr

Number (Long Integer)

Foreign Key to PK of DeptMast table.  Identifies which department the employee works in.

JobNbr

Number (Long Integer)

Foreign Key to PK of JobMast table. Identifies the employee's job.

HireDate

Date/Time

Date the employee was hired

HrlyRate

Number (Single)

Employee's hourly rate

SchedHrs

Number (Single)

The number of hours per week the employee is scheduled to work.

 

DeptMast table:

 

Field Name

DataType

Comments

DeptNbr

Number (Long Integer)

Primary Key; uniquely identifies each department in the database. The PK index was renamed idxDeptNbrPK in the Access interface (see below).

DeptName

Text (50)

The name of the department.  A non-unique index was established on this field, and the index was renamed idxDeptName.

Location

Text (50)

The department's location (could be a building, suite number, floor, etc.)

 

JobMast table: 

 

Field Name

DataType

Comments

JobNbr

AutoNumber

Primary Key; uniquely identifies each job in the database. The PK index was renamed idxJobNbrPK. 

JobTitle

Text (50)

The job title (description). A non-unique index was established on this field, and the index was renamed idxJobTitle.

MinRate

Number (Single)

The minimum hourly rate that somebody working in this position is usually paid.

AvgRate

Number (Single)

The average hourly rate that somebody working in this position is usually paid.

MaxRate

Number (Single)

The maximum hourly rate that somebody working in this position is usually paid.

                                                                                               

How to Rename Indexes in the Access UI

 

Note that in the screen-shot of the table design for DeptMast, DeptNbr was set up as the primary key, and that a non-unique index was established for DeptName (this will facilitate faster searching for a record where the DeptName contains a particular value and will allow easier browsing of the DeptMast table in DeptName sequence).

 

 

To examine information related to the indexes that you set up for a table, click the Indexes icon (looks like a lightning bolt) on the Access toolbar.

 

 

Clicking the Indexes icon causes the Indexes dialog box (shown below) to be displayed.  Note that under the "Index Name" column, I renamed the indexes.  The Index Name for the DeptNbr field was changed from "PrimaryKey" to "idxDeptNbrPK" (the Access default index name for the primary key field is "PrimaryKey") and the Index Name for the DeptName field was changed from "DeptName" to "idxDeptName" (the Access default index name for non-primary key fields is the same as the Field Name).

 

 

The DAO Object Model

 

An essential part of learning how to program Access database applications is to gain a working knowledge of the DAO (Data Access Objects) object model, shown on the following page.   An object model is a representation, or conceptual map, of an object's functionality in terms of an object hierarchy.  The objects in the object model are said to be "exposed", meaning that they are items that can be programmed or controlled.

 

The objects in the object model are organized into various levels. You can think of these levels as tiers in a hierarchy.  The topmost tier in the DAO object model is the JET database engine itself  (DBEngine).  The second tier consists of a high-level categorization of objects. The third, fourth and fifth tiers, etc. include a variety of different objects used to access the functionality that the second-tier objects contain.  You traverse the tiers to find the objects you want to use.

 

A group of similar objects can be combined in the hierarchy as a collection. In general, the plural names ("Databases", "Recordsets", etc.) are collections and the singular names ("Database", "Recordset", etc.) are objects with the collection.

 

Collection Syntax

 

To refer to an object in a collection, the syntax is:

 

            CollectionName.Item("Key")  -- or --  CollectionName.Item(index)

 

Item is the default method for all collections; therefore .Item can always be dropped from the above syntax, reducing it to:

 

            CollectionName("Key")  -- or --  CollectionName(index)

 

An object's ­key is a string that uniquely identifies that object in the collection.  For example, the DeptNbr field in the collection of fields of a table could be referred to as Fields("DeptNbr").  The index refers to the object's ordinal position in the collection, which could change if items are added to or removed from the collection.  If the DeptNbr field is the first field in the Fields collection, it could be referred to as Fields(0).  (Note: It is generally preferable to use the key rather than the index to access items in a collection.  Since the index for an item in a collection is subject to change, its use would be limited to situations such as where you are looping through the items one by one, perhaps to display information about each item, or just to verify what items are in the collection.)

 

In looking at the DAO object model, you see a good number of collections and objects.  Each of these objects has numerous methods and properties.  However, in a typical VB/DAO application, you will only need to deal with a handful of these collections and objects.  Most likely, you will use Workspace object (indirectly), the Database object, and the Recordsets, TableDefs, and possibly QueryDefs collections.  The collections and objects used in the sample project presented in this document, along with their properties and methods will be discussed as they are encountered, as we examine the processing that takes place in each of the project's forms.

 

Good reference material for each of these items can be found in the Access help system.  In addition, there are a number of good reference books on JET / DAO.  One of the best books on the subject is the "Microsoft Jet Database Engine Programmer's Guide" by Dan Haught and Jim Ferguson (Microsoft Press, 1997).

 

 

 

The DAO (Data Access Objects) Object Model

 

Using DAO in Your VB Project

 

VB projects that will process an Access-style (JET) database must include a reference to Microsoft DAO 3.51 Object Library.  To include this reference, go to the VB Project menu and select References.  From the resulting dialog box, check that reference (shown below):

 

 

Note:  When you use the data control, setting this reference is not necessary (VB will set it automatically).

 

The Sample Project (prjDAODemo)

 

The sample project contains seven forms and one standard module, as summarized below.

 

Forms:

 

Name

Description

frmSplash

The splash screen

frmMainMenu

The main menu, or "switchboard" screen

frmHelp

The form where help files are displayed

frmDeptMaint

Used to add, change, or delete records from the DeptMast table

frmJobMaint

Used to add, change, or delete records from the JobMast table

frmEmpMaint

Used to add, change, or delete records from the EmpMast table

frmReportMenu

Allows the user to select a (Crystal) report to be printed

 

Modules:

 

Name

Description

frmSplash

Standard module containing public variables, subs, and functions.

 

modCommon

 

We will look at each form in the sample project in turn, but first, let's take a look at the code that's in the standard module (listed a little further below).   In the general declarations section, you see the statement

 

Public gobjEmpDB As Database

 

"Database" is a specific type of object variable. Once the Microsoft DAO 3.51 Object Library has been included in your project, variables defined as any of the object types present in the DAO object model (Database, TableDef, Recordset, Field, etc.) can be used in the project.

 

 In addition to the CenterForm routine and the GetAppPath function, there are two database-related routines, one to open the database and one to close it.  In this project, each form that uses the database calls the OpenEmpDatabase sub when the form is loaded and calls the CloseEmpDatabase sub when the form is unloaded.

 

The OpenDatabase Method

 

The Sub OpenEmpDatabase contains the single statement:

 

Set gobjEmpDB = OpenDatabase(GetAppPath() & "EMPLOYEE.MDB")

 

Recall that gobjEmpDB was declared as a "Database" variable, which is a specific type of object variable. Unlike standard VB variables such as "Integer" and "String", object variables must be initialized with the Set statement.  The Set statement establishes a valid reference to an object variable.

 

OpenDatabase is a method of the Workspace object in the Workspaces collection (and of course Workspaces is a collection of the DBEngine object).  A Workspace object exists for each active session of the Jet database engine.  A session delineates a sequence of operations performed by MS Jet.  A session begins when a user logs on and ends when a user logs off.  When your DAO application starts executing, the first Workspace object of the Workspaces collection (referenced as Workspaces(0)) is already created.  Workspaces(0) is also referred to as the default workspace.

 

Since the DBEngine object and the default Workspaces item (Workspaces(0)) are automatically available to an application that includes the reference to the Microsoft DAO 3.51 Object Library and do not need to be explicitly referenced when using "OpenDatabase", although they could be, as in the following statement:

 

Set gobjEmpDB = DBEngine.Workspaces(0).OpenDatabase(GetAppPath() & "EMPLOYEE.MDB")

 

The OpenDatabase method requires a string argument evaluating to the name of the database file to be used, followed by optional arguments not used in the example above.  It opens the requested database file and returns an appropriate object reference to the Database variable. The above statement opens the EMPLOYEES.MDB database file, located in the same path as the VB program, and sets up the variable gobjEmpDB to reference this database.

           

The Database Object

 

Once you have a valid reference to the database via the OpenDatabase method, you can then use the various methods and properties of the Database object in code, using the Database object variable.  Methods commonly used with the Database object are Execute, Close, and OpenRecordset. The OpenRecordset method is by far the most commonly used method of the Database object and is used liberally in several of this project's forms.  OpenRecordset will be discussed a little later, when those forms are looked at.

 

The Execute method is used to execute SQL statements that return no rows on the database.  This basically includes non-SELECT queries: DDL queries such as CREATE TABLE or DROP TABLE, and action queries such as UPDATE or DELETE.  The Execute method requires a string argument containing a valid SQL statement.

 

For example, the following statement would give all of the employees a 10% raise:

 

gobjEmpDB.Execute "UPDATE EmpMast " _

                & "SET HrlyRate = HrlyRate * 1.1"        

 

Note: The Execute method, while quite useful, was not used in the sample project.

 

The Close method simply closes the database and is coded as gobjEmpDB.Close (see the CloseEmpDatabase Sub).

 

The Nothing Keyword

 

When you are done using an object variable (be it a database object variable, a recordset object variable, or any other type of object variable), you should set that object variable to the VB keyword Nothing, which disassociates an object variable from the actual object and releases memory and system resources associated with the object to which the variable refers. Thus, when the database is closed, the Database object variable should be set to Nothing, as in:

 

      Set gobjEmpDB = Nothing

 

 

Code for the standard module modCommon:

 

Option Explicit

 

Public gobjEmpDB            As Database

Public gintHelpFileNbr      As Integer

 

'------------------------------------------------------------------------

Public Sub OpenEmpDatabase()

'------------------------------------------------------------------------

 

    Set gobjEmpDB = OpenDatabase(GetAppPath() & "EMPLOYEE.MDB")

 

End Sub

 

 

'------------------------------------------------------------------------

Public Sub CloseEmpDatabase()

'------------------------------------------------------------------------

 

    gobjEmpDB.Close

    Set gobjEmpDB = Nothing

 

End Sub

 

'------------------------------------------------------------------------

Public Sub CenterForm(pobjForm As Form)

'------------------------------------------------------------------------

 

    With pobjForm

        .Top = (Screen.Height - .Height) / 2

        .Left = (Screen.Width - .Width) / 2

    End With

 

End Sub

 

'------------------------------------------------------------------------

Public Function GetAppPath() As String

'------------------------------------------------------------------------

 

    GetAppPath = IIf(Right$(App.Path, 1) = "\", App.Path, App.Path & "\")

 

End Function

 

The Splash Screen (frmSplash):

 

The splash screen, named "frmSplash" is shown below (design-time).  This form was established as the startup object for this project.  It contains a Timer control named tmrSplash.  When the timer's Timer event fires, control is transferred to the Main Menu form.

 

 

 

Code for frmSplash:

 

Option Explicit

 

'------------------------------------------------------------------------

Private Sub Form_Load()

'------------------------------------------------------------------------

    CenterForm Me

End Sub

 

'------------------------------------------------------------------------

Private Sub tmrSplash_Timer()

'------------------------------------------------------------------------

    tmrSplash.Enabled = False

    frmMainMenu.Show

    Unload Me

End Sub

 

 

The Main Menu Screen (frmMainMenu):

 

The main menu, or "switchboard" screen, named "frmMainMenu" is shown below.  There is no database-related processing in this form, either.  It contains an array of six command buttons, named cmdMainMenuOpt, indexed 0 to 5.

 

In looking at the code in cmdMainMenuOpt_Click, you can see that for command buttons 0 through 3, the appropriate form is shown. 

 

For command button 4 (Help), a sub named ShowHelpForm is called.  The ShowHelpForm sub is also called when the user presses the F1 key (see the Form_KeyDown event procedure).  Recall that in order for the Form_KeyDown event to work, you should set the form's KeyPreview property to True.  In the ShowHelpForm sub, you see that the public variable gintHelpFileNbr is set to 1.  The reason for this will be explained a further below, when we look at the Help form. The Exit button (cmdMainMenuOpt(5)) simply ends the application.

 

 

 

Code for frmMainMenu:

 

Option Explicit

 

'------------------------------------------------------------------------

Private Sub Form_Load()

'------------------------------------------------------------------------

    CenterForm Me

End Sub

 

'------------------------------------------------------------------------

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

'------------------------------------------------------------------------

 

    If KeyCode = vbKeyF1 Then

        ShowHelpForm

    End If

   

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdMainMenuOpt_Click(Index As Integer)

'------------------------------------------------------------------------

    Select Case Index

        Case 0

            frmEmpMaint.Show vbModal

        Case 1

            frmDeptMaint.Show vbModal

        Case 2

            frmJobMaint.Show vbModal

        Case 3

            frmReportMenu.Show vbModal

        Case 4

            ShowHelpForm

        Case 5

            End

    End Select

 

End Sub

 

'------------------------------------------------------------------------

Private Sub ShowHelpForm()

'------------------------------------------------------------------------

 

    gintHelpFileNbr = 1

    frmHelp.Show vbModal

 

End Sub

 

The Help Screen (frmHelp):

 

The Help screen, named "frmHelp", displays an appropriate help file in a rich textbox.  There are four help files for this application named EDMHELP1.DOC, EDMHELP2.DOC, EDMHELP3.DOC, and EDMHELP4.DOC.  (Despite their DOC extensions, these files were saved in Rich Text format.)  These files contain help for the Main Menu form, Employee Maintenance form, Department Maintenance form, and Job Maintenance form, respectively (actually, that's what they should contain; they really just contain a sentence or two, for the purposes of this sample application).

 

As you saw in the code for the Main Menu form, the public variable gintHelpFileNbr was set prior to showing frmHelp. The frmHelp form then uses that number in the Form_Load event to determine which help file to display in the rich text box.  Note how this line in the Form_Load event generates the appropriate file name:

 

strHelpFileName = GetAppPath & "EDMHELP" & gintHelpFileNbr & ".DOC"

 

The About button shows the "About" message box. The OK button unloads the form, thus returning control to the calling form.

 

A run-time screen-shot as well as the code for frmHelp are shown below:


Code for frmHelp:

 

Option Explicit

 

'------------------------------------------------------------------------

Private Sub Form_Load()

'------------------------------------------------------------------------

 

    Dim strHelpFileName As String

   

    CenterForm Me

   

    strHelpFileName = GetAppPath & "EDMHELP" & gintHelpFileNbr & ".DOC"

   

    rtbHelp.LoadFile strHelpFileName, rtfRTF

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdOK_Click()

'------------------------------------------------------------------------

 

    Unload Me

   

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdAbout_Click()

'------------------------------------------------------------------------

 

    MsgBox "DAO (Data Access Objects) Demo" & vbNewLine _

         & "Employee Database Maintenance" & vbNewLine _

         & "Copyright " & Chr$(169) & " 2000-2005 thevbprogrammer.com", _

            vbInformation, _

            "About"

 

End Sub

 

 

The Data Entry Screens (frmDeptMaint, frmJobMaint, frmEmpMaint)

 

In the data entry screens for the demo application, the user can browse through the records in the table (one record per screen) using "First Record", "Previous Record", "Next Record" and "Last Record" buttons. In addition, the user can perform a search to jump to a particular record based on entered criteria.  The user can add, update, or delete a record using "Add Record", "Update Record", and "Delete Record" buttons respectively.

 

Initially, the user can "look but not touch" the data, as they perform various move or search operations. When the user initiates an add or an update, the controls (generally textboxes) for the data fields as well as the "Save", "Undo" and "Cancel" buttons become enabled; all other buttons become disabled.

 

As the user enters or modifies data in the controls, field-by-field data validation is performed. This means that the user cannot move to a specific control until all the controls before it pass edit (for example, if a form contained first name, last name, and address fields, the user could not move on to the last name field until the first name field was entered and the user could not move on to the address field until the last name field was entered).

 

As indicated above, when an add or update is in progress, the user has three options available via the "Save", "Undo" and "Cancel" buttons:

 

 If the user clicks the "Accept" button, provided that all entries pass validation, the record is added or updated in the database table and the form controls are set back to their original state (textboxes and Accept, Undo, and Cancel buttons are disabled, all other buttons are enabled).

 

 If the user clicks the "Undo" button instead, the controls on the form are re-populated with the corresponding fields from the current record (if doing an update) or the controls on the form are cleared (if doing an add). The form remains in a state in which the user can add or modify data.

 

If the user clicks "Cancel", the fields of the previously current record are re-assigned to their corresponding textboxes on the form, and, as with the "Save" button, the form controls are set back to their original state (textboxes and Save, Undo, and Cancel buttons are disabled, all other buttons are enabled).

 

It should be noted that the data entry approach implemented by the demo application as described above is a restrictive approach that attempts to control the user's actions to the greatest degree possible. This approach may be appropriate in some cases but not in others – it depends on the type of application as well as what the users are familiar with. If we were to "loosen" things up a bit, the field-by-field validation could be eliminated and validation would be done only when the record is about to be saved (this way the user could move around on the form; skip fields then come back to them, etc.). If we were to loosen things up further, we could eliminate the "two state" approach between browsing and updating – in other words, have all fields open all the time and not make the user explicitly click a button to initiate an update. Regardless of the approach used, your application will need to detect when the user has made changes and ensure the integrity of the data.

 

Implementing Field-by-Field Validation

 

In order to implement field-by-field validation as described above, the following points should be considered:

·         All controls on your form should have their TabIndex property set such that the tabbing order is correct.

·         The MaxLength property should be set for all textboxes where appropriate.

·         A form-level integer variable to store the TabIndex property of the currently active field should be declared (in the sample application it is called intCurrTabIndex).

·         A form-level Boolean variable indicating whether or not a validation error occurred should be declared (in the sample application it is called blnValidationError).

·         A routine (Sub) which contains validation code for all enterable fields should be coded (in the sample application this Sub is called  ValidateAllFields).

·         Logic for the GotFocus, KeyPress (if necessary), and Change events should be coded for each textbox; logic for the Validate event should be coded for the last textbox.

 

The basic logic coded in each of the events is as follows:

 

GotFocus:

(1)  Set intCurrTabIndex to the TabIndex property of this textbox.

(2)  Call the ValidateAllFields routine.

(3)  If there was a validation error (mblnValidationError = True), exit now (skipping the next two statements).

(4)  Set the SelStart property of this textbox to 0.

(5)  Set the SelLength property of this textbox to the length of the text currently in this textbox.

     

Note: The first three statements above can be omitted in the GotFocus event of the first textbox to be validated. Those three statements are basically saying to the user "You can't come here until you've dealt with your previous errors." Statements 4 and 5 cause the text in the textbox to be highlighted when it receives focus.

 

KeyPress:

Place optional code in here to filter out undesirable characters entered by the user (for example, if a fields is to contain only numeric digits, you can filter out anything else).  You can also change the character entered by the user (the most common conversion done here is to convert all lowercase characters entered by the user to uppercase).

 

Change:

      If the length of the text in this field is equal to its MaxLength property, then set the focus to the next enterable field. (This provides an auto-tab feature for the form fields.)

 

Validate:

Introduced in VB6, the Validate event can be used in conjunction with the CausesValidation property to prevent a control from losing the focus until certain criteria are met.  The Validate event only occurs when the control which is about to receive the focus has its CausesValidation property set to True. The Validate event fits into the field-by-field data entry scheme for the last field to be validated. (In the sample application, the Validate event is coded for the last data entry field, and the Save button has its CausesValidation property set to True. When the user tabs out of the last field and into the Save button, the Validate event fires for the last field. If the Validate event deems that the field has not passed edit, the Cancel parameter of the Validate event is set to True, causing focus to remain on that field.) Note: Some resources advocate the use of the Validate event for all of the fields to be validated; this is not done in the sample application because the Validate event will fire whether you are moving backwards or forward through the fields on the form – the intention in the sample application is to validate only when moving forward.

 

·         The basic logic (in pseudocode) for the ValidateAllFields Sub is as follows:

 

    mblnValidationError = False

   

    If FIELD_1 is NOT valid Then

        mblnValidationError = True

        MsgBox "Error in Field 1"

        FIELD_1.SetFocus

    End If

 

If (mintCurrTabIndex = FIELD_2.TabIndex) _

Or (mblnValidationError = True) Then

    ' The user has either just tabbed to FIELD_2 (in which case FIELD_2 is

    ' not yet ready to be checked), or FIELD_1 has an error. In either case,

    ' there is no point in continuing ...

    Exit Sub

End If  

 

    If FIELD_2 is NOT valid Then

        mblnValidationError = True

        MsgBox "Error in Field 2"

        FIELD_2.SetFocus

    End If

 

If (mintCurrTabIndex = FIELD_3.TabIndex) _

Or (mblnValidationError = True) Then

    ' The user has either just tabbed to FIELD_3 (in which case FIELD_3 is

    ' not yet ready to be checked), or FIELD_2 has an error. In either case,

    ' there is no point in continuing ...

    Exit Sub

End If  

        . . .

    If LAST_FIELD is NOT valid Then

        mblnValidationError = True

        MsgBox "Error in Last Field"

        LAST_FIELD.SetFocus

    End If

 

    ' End of Sub 

 

The information presented above to implement field-by-field data validation can be simplified by the use of control arrays, particularly if all of the data entry fields are textboxes. By using a textbox control array, all textboxes would share the same GotFocus, KeyPress, Change, and Validate event. You would know which textbox you were "on" by testing the Index argument that is passed into the event. Similarly, the logic for the ValidateAllFields Sub would also be simplified.

 

The sample application uses control arrays on two of three data entry forms.

 
The Department Maintenance Form (frmDeptMaint):

 

The Department Maintenance form, shown below, enables the user to perform maintenance on the DeptMast table.

 

Processing note: The department number field, while it must be unique, is not an autonumber field – therefore, during an "add", the user will have to enter it.  During an update, the user should not be permitted access to the department number.

 

 

The code behind this form introduces a number of DAO methods and properties as discussed below.

 

The OpenRecordset Method

 

The OpenRecordset method of the Database object is used to establish a reference to a set of records, such as a table or the results of a query.  This set of records is assigned to a Recordset object variable, and can then be processed record by record as if it were a file. The Recordset object is temporary object; it is created by the OpenRecordset method in code and is destroyed when it is closed or set to Nothing (it is not a "permanent" object like a table or saved query, although it is derived from these sources).   The Recordset object is similar to what is called a "cursor" in other database systems.

 

The syntax is:

 

Set RecordsetVariable = DatabaseVariable.OpenRecordset (source, type, options, lockedits)

 

The source argument is a string representing the name of the table or query you want to refer to.  A SQL statement itself can also be used here.

 

The type argument is a constant specifying the way you want to process the recordset.  The recordset can be processed as a table, dynaset, or snapshot, and the constants dbOpenTable, dbOpenDynaset, or dbOpenSnapshot respectively are used to refer to these.  If this argument is omitted, Jet will default to the type it deems most appropriate, based on the source.  The three types of recordsets are compared in the table a little further below.

 

The options and lockedits arguments are optional and will not be used in the sample application.

 

Following are two statements that employ OpenRecordset, pulled from this form’s code.

 

 The statement

 

Set mobjDeptRst = gobjEmpDB.OpenRecordset("DeptMast", dbOpenTable)

 

enables the recordset object variable mobjDeptRst to reference the table "DeptMast" in the EMPLOYEES.MDB.  This statement assumes that a valid reference to the Database variable gobjEmpDB has been set via the OpenDatabase method (discussed previously) and that the variable mobjDeptRst as been declared as a Recordset object variable (as in Private mobjDeptRst As Recordset).

 

The statement

 

Set objTempRst = gobjEmpDB.OpenRecordset _

                 ("SELECT COUNT(*) AS EmpCount FROM EmpMast " _

                  & "WHERE DeptNbr = " & mobjDeptRst!DeptNbr)

 

enables the recordset object variable objTempRst to reference the results of the SELECT query coded as the source argument.  Again, this example assumes that the Database variable gobjEmpDB has been properly set, and that objTempRst has been declared as a Recordset variable (i.e., Dim objTempRst As Recordset).  The type argument is omitted, so Jet should default to the dynaset type in this case.  The meaning of  mobjDeptRst!DeptNbr will be discussed shortly.

 

Types of Recordsets

 

Recordset Type

Source Constant

Advantages

 

Drawbacks

Table

dbOpenTable

·         Allows direct access to a database table

·         Can use indexes

·         Searches are fast

·         Can update records in the underlying table

·         can reference a single table only

·         can search only on available indexes (using the "Seek" method)

·         can't limit the number of records returned

Dynaset

 

dbOpenDynaset

·         Can select specific records and fields

·         Can use SQL statements to do joins

·         Search can be based on any field (using the "Find" methods)

·         Records in the underlying table(s) may or may not be updateable

·         Searches are slower than Table type

·         Can't make use of indexes

Snapshot

dbOpenSnapshot

·         Similar to advantages of Dynaset

·         Faster because it is a memory-based copy of the data

·         Read-only

 

Once a valid reference to the desired recordset has been established via the OpenRecordset method, you can then use the various methods and properties of the recordset object in code, using the recordset object variable.  Methods include the Move methods, Seek (for table-type recordsets), the Find methods (for dynaset-type recordsets), AddNew, Edit, Update, and Delete.  Properties include EOF/BOF, Index, and Bookmark.  The methods and properties are referenced in code using standard VB "dot" notation, as will be shown in several of the following examples.

 

The following examples assume that mobjDeptRst has been declared as a Recordset variable, as in:

 

Private mobjDeptRst As Recordset

 

and that mobjDeptRst has been opened with the OpenRecordset method, as in:

 

Set mobjDeptRst = gobjEmpDB.OpenRecordset("DeptMast", dbOpenTable)

 

The Move Methods

 

The four Move methods (MoveFirst, MovePrevious, MoveNext, and MoveLast) cause the recordset to move to the first, previous, next, or last record, respectively, making that record the current record.  You would code statements like the following:

 

            mobjDeptRst.MoveFirst

            mobjDeptRst.MovePrevious

            mobjDeptRst.MoveNext

            mobjDeptRst.MoveLast

 

Using the BOF and EOF Properties

 

When you are moving forward with MoveNext, there is the possibility that you will reach the end of the recordset, and you don't want to move past it.  If you move past the end, there will be no current record, which will result in errors if you try to retrieve data from the recordset.  Therefore, you should use the EOF (end of file) property of the recordset to test for this.  When browsing the recordset, if EOF is true, the common solution to move to a valid record is to move to the last record:

 

      mobjDeptRst.MoveNext

      If mobjDeptRst.EOF Then

          mobjDeptRst.MoveLast

      End If

 

Similarly, when you are moving backward with MovePrevious, there is the possibility that you will reach the top, or beginning, of the recordset, and you don't want to move past that.  If you move past the beginning, there will be no current record, which will result in errors if you try to retrieve data from the recordset.  Therefore, you should use the BOF (beginning of file) property of the recordset to test for this.  When browsing the recordset, if BOF is true, the common solution to move to a valid record is to move to the first record:

 

      mobjDeptRst.MovePrevious

      If mobjDeptRst.BOF Then

          mobjDeptRst.MoveFirst

      End If

 

Note: When you use the same object reference in multiple statements, you may prefer to enclose the code in a With/End With block, as follows:

 

      With mobjDeptRst

    .MoveNext

          If .EOF Then

            .MoveLast

          End If

                End With

 

The RecordCount Property

 

For table-type recordsets, the RecordCount property will reflect the actual number of records in the table after OpenRecordset is executed.  For dynaset-type recordsets, the RecordCount property reflects the number of records "visited".  This means that for a dynaset, after OpenRecordset is executed, the first record is the current record, and the RecordCount property will have a value of 1.  If you want the full count, you should use the MoveLast method on the recordset (you can follow that with a MoveFirst to get back to the first record).  After the MoveLast, interrogation of the RecordCount property should reveal the full count.

 

Index, Seek, NoMatch, and Bookmark

 

The Index property and the Seek method can only be used on table-type recordsets; using them on a dynaset-type recordset will produce an error like "Object does not support this property or method".  The NoMatch property can be used with any type of recordset (use it after a table Seek or dynaset Find).

 

The Index property of a table-type recordset refers to the name of the index that you want to use with the table.  The Indexes include the primary key as well as any other indexes you have established.  Recall from earlier in this document that two indexes were set up for the DeptMast table: idxDeptNbrPK and idxDeptName.  Indexes are used for two main reasons: (1) to change the browsing sequence, and (2) to search for a record based on a value in a particular field.

Regarding changing the browsing sequence, consider the following code:

 

      mobjDeptRst.Index = "idxDeptNbrPK"

      mobjDeptRst.MoveFirst

      ' The first record in department number sequence

' (the one with the lowest department number) would become current

 

      mobjDeptRst.Index = "idxDeptName"

      mobjDeptRst.MoveFirst

      ' The first record in department name sequence (the one closest to "A"

' alphabetically) would become current

 

In a table-type recordset, if you want to find a record based on a value in a particular field, an index must have been established on that field (as we saw earlier when the DeptMast table was set up in Access).  You can then use the Seek method to search for the desired record.  The syntax is:

 

      recordsetvariable.Seek "comparison operator", search value

 

The comparison operator is a string evaluating to one of the five symbols: "=", ">=", "<=", ">", or "<".  The search value is the value that you are looking for in the field on which the current index is based.

 

For example, suppose you wanted to go to the record for department number 220.  First, you would make sure that the Index is set to "idxDeptNbrPK".  Then you would do a Seek with an equal ("=") comparison for the value of 220:

 

      mobjDeptRst.Index = "idxDeptNbrPK"

      mobjDeptRst.Seek "=", 220

 

Now suppose you wanted to go to the finance department.  You don't know what the department number is, and you're not sure if it's called "FINANCE" or "FINANCIAL PLANNING" or something else.  First, you would make sure that the Index is set to "idxDeptName".  You could then do a Seek with a greater than or equal to (">=") comparison for the value of  "FINA".  This would return the first record where the first four letters of the department name were "FINA".  The code is:

 

      mobjDeptRst.Index = "idxDeptName"

      mobjDeptRst.Seek ">=", "FINA"

 

Whenever you search for a record, if the system finds it, that record becomes the current record.  But there is always the possibility that the desired record will not be found.  To test whether or not the system found your record, you must use the NoMatch property of the recordset.  After a Seek (or a Find in the case of a dynaset), the (Boolean) NoMatch property will be updated with True or False, indicating whether or not the record was found.  "False" is good – it means there was a match!  If NoMatch is True, then the record was not found.

 

Using NoMatch is all well and good, but it is not enough.  Because if NoMatch is True, then there will be no current record.  What would be nice is if you could go back to the record that was current before you attempted the Seek.  This is where the Bookmark property comes in.  The recordset's Bookmark property is a binary string representing the current record.  If you save the Bookmark value before you do the Seek (and you should use a Variant variable to save the Bookmark value), then, if the Seek results in a NoMatch, you can set the Bookmark property back to its old value using the Variant variable.  These points are demonstrated in the code segment below:

 

                Dim lngDeptNbr  As Long

      Dim vntBookmark As Variant

 

      mobjDeptRst.Index = "idxDeptNbrPK"

      vntBookmark = mobjDeptRst.Bookmark

      lngDeptNbr = Val(InputBox("Enter dept # to find:", "Find Dept #")

      mobjDeptRst.Seek "=", lngDeptNbr

      If mobjDeptRst.NoMatch Then

          Msgbox "Dept # " & lngDeptNbr & " was not found.", vbInformation, "Dept Not Found"

          mobjDeptRst.Bookmark = vntBookmark

      End If

 

Other Notes Regarding Table-type Recordsets

·         If you want to search a table for a value in a field that is not indexed, you must open the table as a dynaset and use one of the Find methods – this will be examined later, when we look at the Employee Maintenance form.

·         To avoid "type mismatch" errors in using the Seek method, make sure that your search value is a data type that is compatible with the indexed field.  If your indexed field is numeric, your search value should be a numeric variable or constant; if your indexed field is text, your search value should be a string variable or quoted string constant.

 

Recordset Fields

 

If you refer back to the DAO Object Model, you will see that Fields is a collection of the Recordset object.  Once a recordset is created, its Fields collection is updated to include the fields or columns that make up the recordset.  Recall that an item in a collection is referred to with either its key or with its index.  Recall that the key is a unique string that identifies an item in a collection – in the case of Fields, it is the Field name; and this is the preferred way to reference a Field in a collection.  The index is a number that identifies the position of the item in the collection.

 

Recall the collection syntax:

 

            CollectionName.Item("Key")  -- or --  CollectionName.Item(index)

 

Recall that you can always drop .Item, reducing the syntax to:

 

            CollectionName("Key")  -- or --  CollectionName(index)

 

Since a collection is attached to an object, the object variable, followed by a dot, would appear in front of the collection name, as in:

 

      ObjectVariable.CollectionName("Key")  -- or --  ObjectVariable.CollectionName(index)

 

Therefore, if the field DeptNbr is the first field in the Fields collection of the recordset object mobjDeptRst, the syntax to reference the DeptNbr field is:

 

                                mobjDeptRst.Fields("DeptNbr")  -- or --  mobjDeptRst.Fields(0)

 

Each object the DAO object model has a default collection; and the default collection name can be dropped from the syntax.  Since Fields is the default collection of the Recordset object, you can drop .Fields from the above syntax, reducing it to:

 

                                mobjDeptRst("DeptNbr")  -- or --  mobjDeptRst(0)

 

If a field name contains blank spaces, the field name must be enclosed in square brackets, as in:

rsMyRecSet("[Field With Blanks]")

 

 

The Bang (!) Operator

 

Alternatively, the "bang" operator (!) can be used to specify a programmer-created item of a collection. The syntax is:

 

ObjectVariable.CollectionName!ItemName

 

If the collection is the default collection of the object in question, the syntax is then reduced to:

 

ObjectVariable!ItemName

 

Therefore, a field in a recordset can also be referenced as:

 

RecordsetVariable!FieldName

 

So another way to reference the DeptNbr field of the mobjDeptRst recordset is:

 

mobjDeptRst!DeptNbr

 

In the above syntax, note that the field name is not enclosed in either quotes or parentheses.  Still, if the field contains blank spaces, the square brackets must be used, as in:

 

      sMyRecSet![Field With Blanks]

 

In the sample application, the bang operator syntax is used for all field references.

For example, a segment of code that populates the txtDeptField textboxes from the mobjDeptRst recordset could be coded as follows:

 

        txtDeptField(0).Text = mobjDeptRst!DeptNbr

        txtDeptField(1).Text = mobjDeptRst!DeptName

        txtDeptField(2).Text = mobjDeptRst!Location

 

As mentioned earlier, when you use the same object reference in multiple statements, you may prefer to enclose the code in a With/End With block, as follows:

 

        With mobjDeptRst

            txtDeptField(0).Text = !DeptNbr

            txtDeptField(1).Text = !DeptName

            txtDeptField(2).Text = !Location

        End With

 

 

The AddNew, Edit, Update, and Delete Methods

 

The AddNew method creates a temporary buffer containing an empty structure of the recordset record.  If the record contains an AutoNumber field, it is populated at this time.  In code, you assign values to the recordset fields.  When you are done assigning values to the fields, you use the Update method to write the new record to the recordset.  You should save the value of the current record's Bookmark prior to the AddNew, so that you can get back to the current record if the user "undoes" the record-add process.  In any event, no new record will be added without the Update method.  After a new record is successfully added, it does not become the current record.  To make the new record the current record, use the LastModified method of the recordset.

 

The Edit method creates a temporary buffer containing the structure and data of the current recordset record.  In code, you assign (new) values to the recordset fields.  When you are done assigning values to the fields, you use the Update method to update the new record in the recordset.  The changes will not "take" without the Update method.

 

The Delete method deletes the current record in the recordset.  After the Delete, there is no current record until you use one of the Move methods (such as MoveNext).

 

The code for the frmDeptMaint form will be shown shortly, but first, the code for the modCommon bas module will be shown. This module contains declarations for global variables as well as public  Sub and Function procedures that can accessed by any form in the application. The modCommon module contains the following Sub and Function procedures:

 

OpenEmpDatabase

Sub to open the employee database using the DAO OpenDatabase method

CloseEmpDatabase

Sub to close the employee database

CenterForm

Sub to center a form on the screen

GetAppPath

Sub to get the application path of a file

ValidKey

Function to validate a keystroke for use in the KeyPress event of a textbox

ConvertUpper

Function to convert an alphabetic character entered in a textbox to uppercase, used in the KeyPress event of a textbox

SelectTextBoxText

Sub to highlight the text of a textbox when it receives focus. Used in the GotFocus event of a textbox.

TabToNextTextBox

Sub to "autotab" from one textbox to another when maximum number of characters that can be entered into the first textbox has been reached.

 

Code for modCommon:

 

Option Explicit

 

Public gobjEmpDB                    As Database

Public gintHelpFileNbr              As Integer

Public Const gstrNUMERIC_DIGITS     As String = "0123456789"

Public Const gstrUPPER_ALPHA_PLUS   As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ,'-"

 

'------------------------------------------------------------------------

Public Sub OpenEmpDatabase()

'------------------------------------------------------------------------

 

    Set gobjEmpDB = OpenDatabase(GetAppPath() & "EMPLOYEE.MDB")

 

End Sub

 

'------------------------------------------------------------------------

Public Sub CloseEmpDatabase()

'------------------------------------------------------------------------

 

    gobjEmpDB.Close

    Set gobjEmpDB = Nothing

 

End Sub

 

'------------------------------------------------------------------------

Public Sub CenterForm(pobjForm As Form)

'------------------------------------------------------------------------

 

    With pobjForm

        .Top = (Screen.Height - .Height) / 2

        .Left = (Screen.Width - .Width) / 2

    End With

 

End Sub

 

'------------------------------------------------------------------------

Public Function GetAppPath() As String

'------------------------------------------------------------------------

 

    GetAppPath = IIf(Right$(App.Path, 1) = "\", App.Path, App.Path & "\")

 

End Function

 

'------------------------------------------------------------------------

Public Function ValidKey(pintKeyValue As Integer, _

                         pstrSearchString As String) As Integer

'------------------------------------------------------------------------

 

'  Common function to filter out keyboard characters passed to this

'  function from KeyPress events.

'

'  Typical call:

'      KeyAscii = ValidKey(KeyAscii, gstrNUMERIC_DIGITS)

'

 

    If pintKeyValue < 32 _

    Or InStr(pstrSearchString, Chr$(pintKeyValue)) > 0 Then

        'Do nothing - i.e., accept the control character or any key

        '             in the search string passed to this function ...

    Else

        'cancel (do not accept) any other key ...

        pintKeyValue = 0

    End If

 

    ValidKey = pintKeyValue

 

End Function

 

'------------------------------------------------------------------------

Public Function ConvertUpper(pintKeyValue As Integer) As Integer

'------------------------------------------------------------------------

 

'  Common function to force alphabetic keyboard characters to uppercase

'  when called from the KeyPress event.

 

'  Typical call:

'      KeyAscii = ConvertUpper(KeyAscii)

'

 

    If Chr$(pintKeyValue) >= "a" And Chr$(pintKeyValue) <= "z" Then

        pintKeyValue = pintKeyValue - 32

    End If

 

    ConvertUpper = pintKeyValue

 

End Function

 

'-----------------------------------------------------------------------------

Public Sub SelectTextBoxText(pobjTextbox As TextBox)

'-----------------------------------------------------------------------------

 

    With pobjTextbox

        .SelStart = 0

        .SelLength = Len(.Text)

    End With

 

End Sub

 

'-----------------------------------------------------------------------------

Public Sub TabToNextTextBox(pobjTextBox1 As TextBox, pobjTextBox2 As TextBox)

'-----------------------------------------------------------------------------

 

    If pobjTextBox2.Enabled = False Then Exit Sub

   

    If Len(pobjTextBox1.Text) = pobjTextBox1.MaxLength Then

        pobjTextBox2.SetFocus

    End If

 

End Sub

 

Now the code for the Department maintenance form ...

 

Code for frmDeptMaint:

 

Option Explicit

 

'************************************************************************

'************************************************************************

'**                                                                    **

'**               F O R M - L E V E L   V A R I A B L E S              **

'**                                                                    **

'************************************************************************

'************************************************************************

 

Private mobjDeptRst                     As Recordset

Private mvntBookMark                    As Variant

Private mstrAction                      As String

Private mblnOKToExit                    As Boolean

Private mblnValidationError             As Boolean

Private mblnChangeMade                  As Boolean

Private mintCurrTabIndex                As Integer

 

'************************************************************************

'************************************************************************

'**                                                                    **

'**    E X E C U T A B L E   C O D E   B E G I N S   H E R E . . .     **

'**                                                                    **

'************************************************************************

'************************************************************************

 

'************************************************************************

'*                                                                      *

'*                    FORM Event Procedures                             *

'*                                                                      *

'************************************************************************

 

'------------------------------------------------------------------------

Private Sub Form_Load()

'------------------------------------------------------------------------

 

    CenterForm Me

   

    OpenEmpDatabase

   

    Set mobjDeptRst = gobjEmpDB.OpenRecordset("DeptMast", dbOpenTable)

    mobjDeptRst.Index = "idxDeptNbrPK"

   

    mblnOKToExit = True

   

    cmdFirst_Click

 

End Sub

 

'------------------------------------------------------------------------

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

'------------------------------------------------------------------------

 

    If KeyCode = vbKeyF1 Then

        cmdHelp_Click

    End If

   

End Sub

 

'------------------------------------------------------------------------

Private Sub Form_Unload(Cancel As Integer)

'------------------------------------------------------------------------

 

    Dim intResponse As Integer

 

    If Not mblnOKToExit Then

        MsgBox "You must complete or cancel the current action " _

             & "before you can exit", vbInformation, "Cannot Exit"

        Cancel = 1

        Exit Sub

    End If

 

    mobjDeptRst.Close

    Set mobjDeptRst = Nothing

 

    CloseEmpDatabase

 

End Sub

 

 

'************************************************************************

'*                           DEPT FIELDS                                *

'************************************************************************

 

'------------------------------------------------------------------------

Private Sub txtDeptField_GotFocus(Index As Integer)

'------------------------------------------------------------------------

 

    SelectTextBoxText txtDeptField(Index)

   

    If Index > 0 Then

        mintCurrTabIndex = txtDeptField(Index).TabIndex

        ValidateAllFields

    End If

   

End Sub

 

'------------------------------------------------------------------------

Private Sub txtDeptField_KeyPress(Index As Integer, KeyAscii As Integer)

'------------------------------------------------------------------------

 

    If KeyAscii < 32 Then Exit Sub

   

    If Index = 0 Then

        ' dept number - allow only digits

        KeyAscii = ValidKey(KeyAscii, gstrNUMERIC_DIGITS)

    Else

        ' dept name or location - force uppercase

        KeyAscii = ConvertUpper(KeyAscii)

    End If

   

End Sub

 

'------------------------------------------------------------------------

Private Sub txtDeptField_Change(Index As Integer)

'------------------------------------------------------------------------

 

    mblnChangeMade = True

   

    If Index < 2 Then

        TabToNextTextBox txtDeptField(Index), txtDeptField(Index + 1)

    End If

   

End Sub

 

'------------------------------------------------------------------------

Private Sub txtDeptField_Validate(Index As Integer, Cancel As Boolean)

'------------------------------------------------------------------------

 

    ' this event is only being used for the last field on the form ...

    If Index = 2 Then

        mintCurrTabIndex = -1

        ValidateAllFields

        If mblnValidationError Then

            Cancel = True

        End If

    End If

 

End Sub

 

'************************************************************************

'*                                                                      *

'*                          COMMAND BUTTON                              *

'*                         Event Procedures                             *

'*                                                                      *

'************************************************************************

 

'------------------------------------------------------------------------

Private Sub cmdFirst_Click()

'------------------------------------------------------------------------

 

    If mobjDeptRst.RecordCount = 0 Then Exit Sub

 

    mobjDeptRst.MoveFirst

    DisplayDeptRecord

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdNext_Click()

'------------------------------------------------------------------------

   

    If mobjDeptRst.RecordCount = 0 Then Exit Sub

 

    With mobjDeptRst

        .MoveNext

        If .EOF Then

            Beep

            .MoveLast

        End If

    End With

   

    DisplayDeptRecord

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdPrev_Click()

'------------------------------------------------------------------------

 

    If mobjDeptRst.RecordCount = 0 Then Exit Sub

 

    With mobjDeptRst

        .MovePrevious

        If .BOF Then

            Beep

            .MoveFirst

        End If

    End With

   

    DisplayDeptRecord

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdLast_Click()

'------------------------------------------------------------------------

 

    If mobjDeptRst.RecordCount = 0 Then Exit Sub

 

    mobjDeptRst.MoveLast

    DisplayDeptRecord

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdAdd_Click()

'------------------------------------------------------------------------

 

    ClearTheForm

   

    mstrAction = "ADD"

    ResetFormControls True, vbWhite

    mblnChangeMade = False

   

    If mobjDeptRst.RecordCount > 0 Then

        mvntBookMark = mobjDeptRst.Bookmark

    End If

 

    mobjDeptRst.AddNew

   

    txtDeptField(0).SetFocus

    mblnOKToExit = False

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdUpdate_Click()

'------------------------------------------------------------------------

   

    If mobjDeptRst.RecordCount = 0 Then

        MsgBox "There are no records currently on file to update.", _

               vbInformation, "Update Record"

        Exit Sub

    End If

   

    mstrAction = "UPDATE"

    ResetFormControls True, vbWhite

    mblnChangeMade = False

   

    mvntBookMark = mobjDeptRst.Bookmark

    mobjDeptRst.Edit

   

    txtDeptField(1).SetFocus

    mblnOKToExit = False

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdDelete_Click()

'------------------------------------------------------------------------

 

    Dim objTempRst  As Recordset

    Dim intEmpCount As Integer

   

    If mobjDeptRst.RecordCount = 0 Then

        MsgBox "There are no records currently on file to delete.", _

               vbInformation, "Delete Record"

        Exit Sub

    End If

 

    If MsgBox("Are you sure you want to delete this record?", _

              vbQuestion + vbYesNo + vbDefaultButton2, _

              "Delete Record") = vbNo Then

        Exit Sub

    End If

 

    ' check for referential integrity violation ...

    Set objTempRst = gobjEmpDB.OpenRecordset _

                 ("SELECT COUNT(*) AS EmpCount FROM EmpMast " _

                  & "WHERE DeptNbr = " & mobjDeptRst!DeptNbr)

    intEmpCount = objTempRst!EmpCount

    objTempRst.Close

    Set objTempRst = Nothing

                 

    If intEmpCount > 0 Then

        MsgBox "This department record cannot be deleted because " _

             & "it is in use by one or more employees.", _

               vbExclamation, _

               "Department Is In Use"

        Exit Sub

    End If

 

    mobjDeptRst.Delete

   

    If mobjDeptRst.RecordCount = 0 Then

        ClearTheForm

    Else

        cmdNext_Click

    End If

   

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdSave_Click()

'------------------------------------------------------------------------

   

    mintCurrTabIndex = -1

    ValidateAllFields

    If mblnValidationError Then Exit Sub

    

    With mobjDeptRst

        If mstrAction = "ADD" Then

            !DeptNbr = txtDeptField(0).Text

        End If

        !DeptName = txtDeptField(1).Text

        !Location = txtDeptField(2).Text

        .Update

        .Bookmark = .LastModified

    End With

   

    ResetFormControls False, vbButtonFace

    mblnOKToExit = True

   

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdUndo_Click()

'------------------------------------------------------------------------

   

    If Not mblnChangeMade Then Exit Sub

 

    If MsgBox("Do you want to abandon your changes to this record?", _

              vbQuestion + vbYesNo, "Undo") = vbNo Then

        Exit Sub

    End If

 

    If mstrAction = "ADD" Then

        ClearTheForm

        txtDeptField(0).SetFocus

    Else

        DisplayDeptRecord

        txtDeptField(1).SetFocus

    End If

 

    mblnChangeMade = False

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdCancel_Click()

'------------------------------------------------------------------------

       

    If mblnChangeMade Then

        If MsgBox("Do you want to abandon your changes to this record?", _

                  vbQuestion + vbYesNo, "Undo") = vbNo Then

            Exit Sub

        End If

    End If

   

    If mobjDeptRst.RecordCount = 0 Then

        ClearTheForm

    Else

        mobjDeptRst.Bookmark = mvntBookMark

        DisplayDeptRecord

    End If

   

    ResetFormControls False, vbButtonFace

    mblnOKToExit = True

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdGoToDeptNbr_Click()

'------------------------------------------------------------------------

 

    Dim strReqDeptNbr       As String

    Dim lngReqDeptNbr       As Long

   

    If mobjDeptRst.Index = "idxDeptName" Then

        If MsgBox("This search will cause the record browsing " _

                & "sequence to change to department number sequence. " _

                & "Is that OK?", vbYesNo + vbQuestion, _

                "Browse Sequence") = vbNo Then

            Exit Sub

        End If

    End If

   

    strReqDeptNbr = InputBox _

        ("Type in the Department # that you are looking for. ", _

         "Go To Dept # ...")

   

    If strReqDeptNbr = "" Then

        ' user clicked the Cancel button on the input box

        ' or did not enter anything

        Exit Sub

    End If

   

    lngReqDeptNbr = Val(strReqDeptNbr)

   

    mvntBookMark = mobjDeptRst.Bookmark

   

    mobjDeptRst.Index = "idxDeptNbrPK"

    mobjDeptRst.Seek "=", lngReqDeptNbr

   

    If mobjDeptRst.NoMatch Then

        MsgBox "Dept # " & lngReqDeptNbr & " could not be found.", _

               vbExclamation, "Dept # Not Found"

        mobjDeptRst.Bookmark = mvntBookMark

    Else

        DisplayDeptRecord

    End If

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdGoToDeptName_Click()

'------------------------------------------------------------------------

 

    Dim strReqDeptName       As String

   

    If mobjDeptRst.Index = "idxDeptNbrPK" Then

        If MsgBox("This search will cause the record browsing " _

                & "sequence to change to department name sequence. " _

                & "Is that OK?", vbYesNo + vbQuestion, _

                "Browse Sequence") = vbNo Then

            Exit Sub

        End If

    End If

   

    strReqDeptName = UCase$(InputBox _

        ("Type in the first several letters of the Department Name that you are looking for. ", _

         "Go To Dept # ..."))

   

    If strReqDeptName = "" Then

        ' user clicked the Cancel button on the input box

        ' or did not enter anything

        Exit Sub

    End If

   

    mvntBookMark = mobjDeptRst.Bookmark

   

    mobjDeptRst.Index = "idxDeptName"

    mobjDeptRst.Seek ">=", strReqDeptName

   

    If mobjDeptRst.NoMatch Then

        MsgBox "Dept Name beginning '" & strReqDeptName & "' could not be found.", _

               vbExclamation, "Dept Not Found"

        mobjDeptRst.Bookmark = mvntBookMark

    Else

        DisplayDeptRecord

    End If

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdHelp_Click()

'------------------------------------------------------------------------

 

    gintHelpFileNbr = 3

    frmHelp.Show vbModal

   

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdExit_Click()

'------------------------------------------------------------------------

 

    Unload Me

   

End Sub

 

'************************************************************************

'*                                                                      *

'*                        PROGRAMMER-DEFINED                            *

'*                 (Non-Event) Procedures & Functions                   *

'*                                                                      *

'************************************************************************

 

'------------------------------------------------------------------------

Private Sub DisplayDeptRecord()

'------------------------------------------------------------------------

 

    Dim intX    As Integer

 

    With mobjDeptRst

        txtDeptField(0).Text = !DeptNbr

        txtDeptField(1).Text = !DeptName

        txtDeptField(2).Text = !Location

    End With

   

End Sub

 

'------------------------------------------------------------------------

Private Sub ResetFormControls(blnEnabledValue As Boolean, lngColor As Long)

'------------------------------------------------------------------------

 

    Dim intX As Integer

 

    fraDeptData.Enabled = blnEnabledValue

   

    For intX = 0 To 2

        txtDeptField(intX).BackColor = lngColor

    Next

   

    If mstrAction = "UPDATE" Then

        txtDeptField(0).Enabled = Not blnEnabledValue

    End If

   

    cmdSave.Enabled = blnEnabledValue

    cmdUndo.Enabled = blnEnabledValue

    cmdCancel.Enabled = blnEnabledValue

 

    cmdFirst.Enabled = Not blnEnabledValue

    cmdNext.Enabled = Not blnEnabledValue

    cmdPrev.Enabled = Not blnEnabledValue

    cmdLast.Enabled = Not blnEnabledValue

    cmdAdd.Enabled = Not blnEnabledValue

    cmdUpdate.Enabled = Not blnEnabledValue

    cmdDelete.Enabled = Not blnEnabledValue

    cmdExit.Enabled = Not blnEnabledValue

   

    mblnOKToExit = False

 

End Sub

 

'------------------------------------------------------------------------

Private Sub ClearTheForm()

'------------------------------------------------------------------------

   

    Dim intX    As Integer

   

    For intX = 0 To 2

        txtDeptField(intX).Text = ""

    Next

   

End Sub

 

'------------------------------------------------------------------------

Private Sub ValidateAllFields()

'------------------------------------------------------------------------

 

    Dim intX    As Integer

       

    mblnValidationError = False

   

    For intX = 0 To 2

        If Not DeptFieldIsValid(intX) Then

            mblnValidationError = True

            Beep

            txtDeptField(intX).SetFocus

        End If

        If intX < 2 Then

            If mintCurrTabIndex = txtDeptField(intX + 1).TabIndex _

            Or mblnValidationError Then

                Exit For

            End If

        End If

    Next

   

End Sub

   

'------------------------------------------------------------------------

Private Function DeptFieldIsValid(intFieldIndex As Integer) As Boolean

'------------------------------------------------------------------------

 

    Dim strMBMsg        As String

    Dim strMBTitle      As String

    Dim blnItsValid     As Boolean

 

    blnItsValid = True

   

    Select Case intFieldIndex

        Case 0

            '*** Department Number

            If mstrAction = "ADD" Then

                ' validation checks for the department number are only

                ' applicable when adding, not updating a record ...

                If txtDeptField(0).Text = "" Then

                    strMBMsg = "Department Number must be entered"

                    strMBTitle = "Department Number"

                    blnItsValid = False

                ElseIf DeptExists(txtDeptField(0).Text) Then

                    strMBMsg = "Department '" & txtDeptField(0).Text _

                         & "' already exists."

                    strMBTitle = "Department Already Exists"

                    blnItsValid = False

                End If

            End If

        Case 1

            '*** Department Name

            If txtDeptField(1).Text = "" Then

                strMBMsg = "Department Name must not be blank"

                strMBTitle = "Department Name"

                blnItsValid = False

            End If

        Case Else

            '*** Location

            If txtDeptField(2).Text = "" Then

                strMBMsg = "Location must be entered"

                strMBTitle = "Location"

                blnItsValid = False

            End If

    End Select

   

    If blnItsValid Then

        DeptFieldIsValid = True

    Else

        DeptFieldIsValid = False

        MsgBox strMBMsg, vbExclamation, strMBTitle

    End If

   

End Function

 

'------------------------------------------------------------------------

Private Function DeptExists(strDeptNbr As String) As Boolean

'------------------------------------------------------------------------

 

    Dim objTempRst   As Recordset

    Dim intDeptCount As Integer

   

    Set objTempRst = gobjEmpDB.OpenRecordset _

                 ("SELECT COUNT(*) AS DeptCount FROM DeptMast " _

                  & "WHERE DeptNbr = " & strDeptNbr)

    intDeptCount = objTempRst!DeptCount

    objTempRst.Close

    Set objTempRst = Nothing

                 

    DeptExists = IIf(intDeptCount = 0, False, True)

   

End Function

 

 

The Job Maintenance Form (frmJobMaint):

 

The Job Maintenance form, named "frmJobMaint", is shown below.  This form enables the user to perform maintenance on the JobMast table.   The techniques used on this form are very similar to those used in frmDeptMaint.  The differences are that there a few more fields on this form and the JobNbr field is an AutoNumber field.

 

 

 

Code for frmJobMaint:

 

Option Explicit

 

'************************************************************************

'************************************************************************

'**                                                                    **

'**               F O R M - L E V E L   V A R I A B L E S              **

'**                                                                    **

'************************************************************************

'************************************************************************

 

Private mobjJobRst                      As Recordset

Private mvntBookMark                    As Variant

Private mstrAction                      As String

 

Private mblnOKToExit                    As Boolean

Private mblnChangeMade                  As Boolean

Private mblnValidationError             As Boolean

 

Private mintCurrTabIndex                As Integer

 

'************************************************************************

'************************************************************************

'**                                                                    **

'**    E X E C U T A B L E   C O D E   B E G I N S   H E R E . . .     **

'**                                                                    **

'************************************************************************

'************************************************************************

 

'************************************************************************

'*                                                                      *

'*                    FORM Event Procedures                             *

'*                                                                      *

'************************************************************************

 

'------------------------------------------------------------------------

Private Sub Form_Load()

'------------------------------------------------------------------------

 

    CenterForm Me

   

    OpenEmpDatabase

   

    Set mobjJobRst = gobjEmpDB.OpenRecordset("JobMast", dbOpenTable)

       

    mblnOKToExit = True

   

    cmdFirst_Click

 

End Sub

 

'------------------------------------------------------------------------

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

'------------------------------------------------------------------------

 

    If KeyCode = vbKeyF1 Then

        cmdHelp_Click

    End If

   

End Sub

 

'------------------------------------------------------------------------

Private Sub Form_Unload(Cancel As Integer)

'------------------------------------------------------------------------

 

    Dim intResponse As Integer

 

    If Not mblnOKToExit Then

        MsgBox "You must complete or cancel the current action " _

             & "before you can exit", vbInformation, "Cannot Exit"

        Cancel = 1

        Exit Sub

    End If

 

    CloseEmpDatabase

 

End Sub

 

'************************************************************************

'*                           JOB FIELDS                                 *

'************************************************************************

 

'------------------------------------------------------------------------

Private Sub txtJobField_GotFocus(Index As Integer)

'------------------------------------------------------------------------

 

    SelectTextBoxText txtJobField(Index)

 

    If Index > 0 Then

        mintCurrTabIndex = txtJobField(Index).TabIndex

        ValidateAllFields

    End If

   

End Sub

 

'------------------------------------------------------------------------

Private Sub txtJobField_KeyPress(Index As Integer, KeyAscii As Integer)

'------------------------------------------------------------------------

 

    If KeyAscii < 32 Then Exit Sub

   

    If Index > 0 Then

        ' rate field - allow only digits and decimal point

        KeyAscii = ValidKey(KeyAscii, gstrNUMERIC_DIGITS & ".")

        ' if text already has a decimal point, do not allow another ...

        If Chr$(KeyAscii) = "." And InStr(txtJobField(Index).Text, ".") > 0 Then

            KeyAscii = 0

        End If

    Else

        ' job description - force uppercase

        KeyAscii = ConvertUpper(KeyAscii)

    End If

   

End Sub

 

'------------------------------------------------------------------------

Private Sub txtJobField_Change(Index As Integer)

'------------------------------------------------------------------------

 

    mblnChangeMade = True

   

    If Index < 3 Then

        TabToNextTextBox txtJobField(Index), txtJobField(Index + 1)

    End If

   

End Sub

 

'------------------------------------------------------------------------

Private Sub txtJobField_LostFocus(Index As Integer)

'------------------------------------------------------------------------

 

    If Index > 0 Then

        txtJobField(Index).Text = Format$(txtJobField(Index).Text, "Fixed")

    End If

   

End Sub

 

'------------------------------------------------------------------------

Private Sub txtJobField_Validate(Index As Integer, Cancel As Boolean)

'------------------------------------------------------------------------

 

    ' this event is only being used for the last field on the form ...

    If Index = 3 Then

        mintCurrTabIndex = -1

        ValidateAllFields

        If mblnValidationError Then

            Cancel = True

        End If

    End If

 

End Sub

 

'************************************************************************

'*                                                                      *

'*                          COMMAND BUTTON                              *

'*                         Event Procedures                             *

'*                                                                      *

'************************************************************************

 

'------------------------------------------------------------------------

Private Sub cmdFirst_Click()

'------------------------------------------------------------------------

 

    If mobjJobRst.RecordCount = 0 Then Exit Sub

 

    mobjJobRst.MoveFirst

    DisplayJobRecord

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdNext_Click()

'------------------------------------------------------------------------

   

    If mobjJobRst.RecordCount = 0 Then Exit Sub

 

    With mobjJobRst

        .MoveNext

        If .EOF Then

            Beep

            .MoveLast

        End If

    End With

   

    DisplayJobRecord

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdPrev_Click()

'------------------------------------------------------------------------

 

    If mobjJobRst.RecordCount = 0 Then Exit Sub

 

    With mobjJobRst

        .MovePrevious

        If .BOF Then

            Beep

            .MoveFirst

        End If

    End With

   

    DisplayJobRecord

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdLast_Click()

'------------------------------------------------------------------------

 

    If mobjJobRst.RecordCount = 0 Then Exit Sub

 

    mobjJobRst.MoveLast

    DisplayJobRecord

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdAdd_Click()

'------------------------------------------------------------------------

 

    ClearTheForm

    ResetFormControls True, vbWhite

    mblnChangeMade = False

   

    If mobjJobRst.RecordCount > 0 Then

        mvntBookMark = mobjJobRst.Bookmark

    End If

 

    mobjJobRst.AddNew

    'display the Access(JET)-generated autonumber ...

    lblJobNbr.Caption = mobjJobRst!JobNbr

   

    mstrAction = "ADD"

    txtJobField(0).SetFocus

    mblnOKToExit = False

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdUpdate_Click()

'------------------------------------------------------------------------

   

    If mobjJobRst.RecordCount = 0 Then

        MsgBox "There are no records currently on file to update.", _

               vbInformation, "Update Record"

        Exit Sub

    End If

 

    ResetFormControls True, vbWhite

    mblnChangeMade = False

   

    mvntBookMark = mobjJobRst.Bookmark

    mobjJobRst.Edit

   

    mstrAction = "UPDATE"

    txtJobField(0).SetFocus

    mblnOKToExit = False

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdDelete_Click()

'------------------------------------------------------------------------

 

    Dim objTempRst  As Recordset

    Dim intEmpCount As Integer

   

    If mobjJobRst.RecordCount = 0 Then

        MsgBox "There are no records currently on file to delete.", _

               vbInformation, "Delete Record"

        Exit Sub

    End If

 

    If MsgBox("Are you sure you want to delete this record?", _

              vbQuestion + vbYesNo + vbDefaultButton2, _

              "Delete Record") = vbNo Then

        Exit Sub

    End If

 

    ' check for referential integrity violation ...

    Set objTempRst = gobjEmpDB.OpenRecordset _

                     ("SELECT COUNT(*) AS EmpCount FROM EmpMast " _

                      & "WHERE JobNbr = " & mobjJobRst!JobNbr)

    intEmpCount = objTempRst!EmpCount

    objTempRst.Close

    Set objTempRst = Nothing

                 

    If intEmpCount > 0 Then

        MsgBox "This job record cannot be deleted because " _

             & "it is in use by one or more employees.", _

             vbExclamation, "Job Is In Use"

        Exit Sub

    End If

 

    mobjJobRst.Delete

   

    If mobjJobRst.RecordCount = 0 Then

        ClearTheForm

    Else

        cmdNext_Click

    End If

   

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdGoToJobNbr_Click()

'------------------------------------------------------------------------

 

    Dim strReqJobNbr       As String

    Dim lngReqJobNbr       As Long

   

    If mobjJobRst.Index = "idxJobName" Then

        If MsgBox("This search will cause the record browsing " _

                & "sequence to change to job number sequence. " _

                & "Is that OK?", vbYesNo + vbQuestion, _

                "Browse Sequence") = vbNo Then

            Exit Sub

        End If

    End If

   

    strReqJobNbr = InputBox _

        ("Type in the Job # that you are looking for. ", _

         "Go To Job # ...")

   

    If strReqJobNbr = "" Then

        ' user clicked the Cancel button on the input box

        ' or did not enter anything

        Exit Sub

    End If

   

    lngReqJobNbr = Val(strReqJobNbr)

   

    mvntBookMark = mobjJobRst.Bookmark

   

    mobjJobRst.Index = "idxJobNbrPK"

    mobjJobRst.Seek "=", lngReqJobNbr

   

    If mobjJobRst.NoMatch Then

        MsgBox "Job # " & lngReqJobNbr & " could not be found.", _

               vbExclamation, "Job # Not Found"

        mobjJobRst.Bookmark = mvntBookMark

    Else

        DisplayJobRecord

    End If

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdGoToJobTitle_Click()

'------------------------------------------------------------------------

 

    Dim strReqJobTitle       As String

   

    If mobjJobRst.Index = "idxJobNbrPK" Then

        If MsgBox("This search will cause the record browsing " _

                & "sequence to change to job title sequence. " _

                & "Is that OK?", vbYesNo + vbQuestion, _

                "Browse Sequence") = vbNo Then

            Exit Sub

        End If

    End If

   

    strReqJobTitle = UCase$(InputBox _

        ("Type in the first several letters of the Job title that you are looking for. ", _

         "Go To Job # ..."))

   

    If strReqJobTitle = "" Then

        ' user clicked the Cancel button on the input box

        ' or did not enter anything

        Exit Sub

    End If

   

    mvntBookMark = mobjJobRst.Bookmark

   

    mobjJobRst.Index = "idxJobtitle"

    mobjJobRst.Seek ">=", strReqJobTitle

   

    If mobjJobRst.NoMatch Then

        MsgBox "Job Title beginning '" & strReqJobTitle & "' could not be found.", _

               vbExclamation, "Job Not Found"

        mobjJobRst.Bookmark = mvntBookMark

    Else

        DisplayJobRecord

    End If

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdSave_Click()

'------------------------------------------------------------------------

   

    mintCurrTabIndex = -1

    ValidateAllFields

    If mblnValidationError Then Exit Sub

   

    With mobjJobRst

        !JobTitle = txtJobField(0).Text

        !MinRate = Val(txtJobField(1).Text)

        !AvgRate = Val(txtJobField(2).Text)

        !MaxRate = Val(txtJobField(3).Text)

        .Update

        .Bookmark = .LastModified

    End With

   

    ResetFormControls False, vbButtonFace

    mblnOKToExit = True

   

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdUndo_Click()

'------------------------------------------------------------------------

 

    If Not mblnChangeMade Then Exit Sub

 

    If MsgBox("Do you want to abandon your changes to this record?", _

              vbQuestion + vbYesNo, "Undo") = vbNo Then

        Exit Sub

    End If

 

    If mstrAction = "ADD" Then

        ClearTheForm

        lblJobNbr.Caption = mobjJobRst!JobNbr

    Else

        DisplayJobRecord

    End If

 

    mblnChangeMade = False

   

    txtJobField(0).SetFocus

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdCancel_Click()

'------------------------------------------------------------------------

       

    If mblnChangeMade Then

        If MsgBox("Do you want to abandon your changes to this record?", _

                  vbQuestion + vbYesNo, "Undo") = vbNo Then

            Exit Sub

        End If

    End If

       

    If mobjJobRst.RecordCount = 0 Then

        ClearTheForm

    Else

        mobjJobRst.Bookmark = mvntBookMark

        DisplayJobRecord

    End If

   

    ResetFormControls False, vbButtonFace

    mblnOKToExit = True

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdHelp_Click()

'------------------------------------------------------------------------

 

    gintHelpFileNbr = 4

    frmHelp.Show vbModal

   

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdExit_Click()

'------------------------------------------------------------------------

 

    Unload Me

   

End Sub

 

 

'************************************************************************

'*                                                                      *

'*                        PROGRAMMER-DEFINED                            *

'*                 (Non-Event) Procedures & Functions                   *

'*                                                                      *

'************************************************************************

 

'------------------------------------------------------------------------

Private Sub DisplayJobRecord()

'------------------------------------------------------------------------

 

    With mobjJobRst

        lblJobNbr.Caption = !JobNbr

        txtJobField(0).Text = !JobTitle

        txtJobField(1).Text = Format$(!MinRate, "Fixed")

        txtJobField(2).Text = Format$(!AvgRate, "Fixed")

        txtJobField(3).Text = Format$(!MaxRate, "Fixed")

    End With

   

End Sub

 

'------------------------------------------------------------------------

Private Sub ResetFormControls(blnEnabledValue As Boolean, lngColor As Long)

'------------------------------------------------------------------------

 

    Dim intX As Integer

 

    fraJobData.Enabled = blnEnabledValue

   

    For intX = 0 To 3

        txtJobField(intX).BackColor = lngColor

    Next

   

    cmdSave.Enabled = blnEnabledValue

    cmdUndo.Enabled = blnEnabledValue

    cmdCancel.Enabled = blnEnabledValue

 

    cmdGoToJobNbr.Enabled = Not blnEnabledValue

    cmdGoToJobTitle.Enabled = Not blnEnabledValue

    cmdFirst.Enabled = Not blnEnabledValue

    cmdNext.Enabled = Not blnEnabledValue

    cmdPrev.Enabled = Not blnEnabledValue

    cmdLast.Enabled = Not blnEnabledValue

    cmdAdd.Enabled = Not blnEnabledValue

    cmdUpdate.Enabled = Not blnEnabledValue

    cmdDelete.Enabled = Not blnEnabledValue

    cmdExit.Enabled = Not blnEnabledValue

   

    mblnOKToExit = False

 

End Sub

 

'------------------------------------------------------------------------

Private Sub ClearTheForm()

'------------------------------------------------------------------------

   

    Dim intX    As Integer

   

    lblJobNbr = ""

    For intX = 0 To 3

        txtJobField(intX).Text = ""

    Next

   

End Sub

 

'------------------------------------------------------------------------

Private Sub ValidateAllFields()

'------------------------------------------------------------------------

 

    Dim intX    As Integer

       

    mblnValidationError = False

   

    For intX = 0 To 3

        If Not JobFieldIsValid(intX) Then

            mblnValidationError = True

            Beep

            txtJobField(intX).SetFocus

        End If

        If intX < 3 Then

            If mintCurrTabIndex = txtJobField(intX + 1).TabIndex _

            Or mblnValidationError Then

                Exit For

            End If

        End If

    Next

   

End Sub

   

'------------------------------------------------------------------------

Private Function JobFieldIsValid(intFieldIndex As Integer) As Boolean

'------------------------------------------------------------------------

 

    Dim strMBMsg        As String

    Dim strMBTitle      As String

    Dim blnItsValid     As Boolean

 

    blnItsValid = True

   

    Select Case intFieldIndex

        Case 0

            '*** Job Title

            If txtJobField(0).Text = "" Then

                strMBMsg = "Job Title must not be blank"

                strMBTitle = "Job Title"

                blnItsValid = False

            End If

        Case 1

            '*** Minimum Rate

            If Val(txtJobField(1).Text) <= 0 Then

                strMBMsg = "Minimum Rate must be greater than zero."

                strMBTitle = "Minimum Rate"

                blnItsValid = False

            End If

        Case 2

            '*** Average Rate

            If Val(txtJobField(2).Text) <= 0 Then

                strMBMsg = "Average Rate must be greater than zero."

                strMBTitle = "Average Rate"

                blnItsValid = False

            ElseIf Val(txtJobField(2).Text) < Val(txtJobField(1).Text) Then

                strMBMsg _

                    = "Average Rate must be greater than or equal to the Minimum Rate."

                strMBTitle = "Average Rate"

                blnItsValid = False

            End If

        Case 3

            '*** Maximum Rate

            If Val(txtJobField(3).Text) <= 0 Then

                strMBMsg = "Maximum Rate must be greater than zero."

                strMBTitle = "Maximum Rate"

                blnItsValid = False

            ElseIf Val(txtJobField(3).Text) < Val(txtJobField(2).Text) Then

                strMBMsg _

                    = "Maximum Rate must be greater than or equal to the Average Rate."

                strMBTitle = "Maxiumum Rate"

                blnItsValid = False

            End If

    End Select

   

    If blnItsValid Then

        JobFieldIsValid = True

    Else

        JobFieldIsValid = False

        MsgBox strMBMsg, vbExclamation, strMBTitle

    End If

   

End Function

 

The Employee Maintenance Form (frmEmpMaint):

 

The Employee Maintenance form, named "frmEmpMaint", is shown below.  This form enables the user to perform maintenance on the EmpMast table.  This is the form that the user would probably interact most with in this application; it could be considered the "main" form.  The techniques used on this form are very similar to those used on the frmDeptMaint and frmJobMaint forms, although more is going on in this form.

 

 

Following is a list of items applicable to this form:

 

·         This form employs combo boxes for the user to set the employee's department, job, and hourly rate.  The department and job combo boxes are the "drop-down list" type, so the user can only choose one of the available items from the lists.  The hourly rate combo box gives the user a choice of selecting the minimum, average, or maximum rate for the job, or they can override it by keying in their own value in the textbox portion of that combo box.

 

·         This form introduces the DTPicker (Date/Time Picker) control.  This control was introduced with VB6.  It enables the user to either key in a date (the control provides automatic date validation) or allows the user to select a date from a drop-down calendar.  The date that the user keys in or selects is stored in the DTPicker control's Value property.

 

The DTPicker will become available in your toolbox when you include Microsoft Windows Common Controls – 2 6.0 (SPx) from Project ŕ Components as shown below:

The DTPicker appears in your toolbox as shown circled below:

The DTPicker in action:

 

·         Due to the variety of controls that represent the employee fields, a control array of textboxes is not used.  The necessary validation is performed on the individual fields using methods previously described.

 

·         This form has a Search area that employs the Find methods of the Recordset object, as described below.

 

The Find Methods

 

The Recordset object has methods FindFirst, FindLast, FindNext, and FindPrevious.  You can use these to search for a particular record in the Recordset.

 

The syntax is

objSomeRecordset.FindFirst criteria

where criteria is a string item consisting of a field name, a relational (comparison) operator, and a value.  It is essentially the same as a SQL WHERE clause without the word WHERE. The comparison operators that can be used are =, >, <, >=, <=, <>, Like, Between, and In.  The value on the right-hand side of the comparison operator must conform to the following rules:

            string values must be enclosed in single quotes

            numeric values are not enclosed in quotes

            date values must be enclosed in #'s (pound signs)

If the criteria is expressed in a literal string, that string must be enclosed in double quotes.  Typically, you must use VB's string-handling functions (especially the "&" for concatenation) to get the desired results.

 

Examples:

objSomeRecordset.FindFirst "ISBN = '123-456-789-0' "

      objSomeRecordset.FindNext "Amount > 100"

      objSomeRecordset.FindNext "DateOfBirth < #1/1/1950#"

      objSomeRecordset.FindNext "Amount > " & txtAmount.Text

      objSomeRecordset.FindNext "FirstName = '" & txtName.Text & "'"

 

            The next example assumes that the variable dtmBirthDay is of the Date data type:

 

      objSomeRecordset.FindNext  _

"DateOfBirth < #" & Format$(dtmBirthDay, "mm/dd/yyyy") & "#"

 

Additional Notes:

·         If the name of the field in the database table has spaces in its name, you must put square brackets around the field name, as in the following example:

 

      objSomeRecordset.FindFirst "[Pay Rate] > 30000"

 

·         For string values, if there is the possibility that the search string will contain an apostrophe, an extra measure should be taken to "double" the apostrophes in the string – otherwise, the apostrophe embedded in the string will be interpreted as the end of the string and a syntax error will most likely result. The easiest way to provide this "insurance" against embedded apostrophes is to use the Replace$ function on the string in question to replace any occurrences of a single apostrophe with two apostrophes:

 

      objSomeRecordset.FindFirst _

                  "ProductName = '" & Replace$(strSearchText, "'", "''") & "'"

 

For example, if strSearchText contained "Chef Anton's Cajun Gumbo", the criteria in the above statement would evaluate to

ProductName = 'Chef Anton''s Cajun Gumbo'

and the double apostrophe in "Anton''s" would be correctly interpreted by the SQL parser as a single apostrophe.

 

In this particular example, if the Replace function was NOT used (i.e., you simply coded

   "ProductName = '" & strSearchText & "'"

for the criteria, the result would be

ProductName = 'Chef Anton's Cajun Gumbo'

which would result in an error: the SQL parser would interpret the criteria to be "Chef Anton" with extraneous characters ("s Cajun Gumbo") at the end.

 

As discussed earlier, the Recordset object has a NoMatch property, which can be used after a Seek (discussed earlier) or after one of the Find methods.  The NoMatch property set to False to begin with.  If you use a Find method and a record is not found, then the NoMatch property is set to True.  You should use this property to determine whether or not a record was found. If a match is found, NoMatch will be set to True, and the found record becomes the current record.

 

Code for frmEmpMaint:

 

Option Explicit

 

'************************************************************************

'************************************************************************

'**                                                                    **

'**               F O R M - L E V E L   V A R I A B L E S              **

'**                                                                    **

'************************************************************************

'************************************************************************

 

Private mobjEmpRst              As Recordset

Private mblnOKToExit            As Boolean

Private mvntBookMark            As Variant

Private mstrAction              As String

 

Private intCurrTabIndex         As Integer

Private mblnValidationError     As Boolean

Private mblnActivated           As Boolean

Private mblnChangeMade          As Boolean

   

'************************************************************************

'************************************************************************

'**                                                                    **

'**    E X E C U T A B L E   C O D E   B E G I N S   H E R E . . .     **

'**                                                                    **

'************************************************************************

'************************************************************************

 

'************************************************************************

'*                                                                      *

'*                    FORM Event Procedures                             *

'*                                                                      *

'************************************************************************

 

'------------------------------------------------------------------------

Private Sub Form_Activate()

'------------------------------------------------------------------------

 

    If mblnActivated Then Exit Sub Else mblnActivated = True

   

    CenterForm Me

    OpenEmpDatabase

   

    If gobjEmpDB.TableDefs("DeptMast").RecordCount = 0 Then

        MsgBox "There are no records in the DeptMast table. " _

             & "At least one record must be present in the DeptMast " _

             & "table in order for Employee maintenance to take place. ", _

             vbExclamation, "No DeptMast Records"

        Unload Me

        Exit Sub

    End If

   

    If gobjEmpDB.TableDefs("JobMast").RecordCount = 0 Then

        MsgBox "There are no records in the JobMast table. " _

             & "At least one record must be present in the JobMast " _

             & "table in order for Employee maintenance to take place. ", _

             vbExclamation, "No JobMast Records"

        Unload Me

        Exit Sub

    End If

   

    Set mobjEmpRst = gobjEmpDB.OpenRecordset("EmpMast", dbOpenDynaset)

   

    LoadDeptCombo

    LoadJobCombo

   

    cboField.ListIndex = 0

    cboRelOp.ListIndex = 0

   

    mblnOKToExit = True

   

    cmdFirst_Click

 

End Sub

 

'------------------------------------------------------------------------

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

'------------------------------------------------------------------------

 

    If KeyCode = vbKeyF1 Then

        cmdHelp_Click

    End If

   

End Sub

 

'------------------------------------------------------------------------

Private Sub Form_Unload(Cancel As Integer)

'------------------------------------------------------------------------

 

    Dim intResponse As Integer

 

    If Not mblnOKToExit Then

        MsgBox "You must complete or cancel the current action " _

             & "before you can exit", vbInformation, "Cannot Exit"

        Cancel = 1

        Exit Sub

    End If

 

    mobjEmpRst.Close

    Set mobjEmpRst = Nothing

   

    CloseEmpDatabase

 

End Sub

 

'************************************************************************

'*                           EMPLOYEE FIELDS                            *

'*                TextPlus and Comob Box Event Procedures               *

'************************************************************************

 

'------------------------------------------------------------------------

Private Sub txtEmpFirst_GotFocus()

'------------------------------------------------------------------------

    SelectTextBoxText txtEmpFirst

End Sub

 

'------------------------------------------------------------------------

Private Sub txtEmpFirst_KeyPress(KeyAscii As Integer)

'------------------------------------------------------------------------

 

    If KeyAscii < 32 Then Exit Sub

   

    KeyAscii = ValidKey(ConvertUpper(KeyAscii), gstrUPPER_ALPHA_PLUS)

   

End Sub

 

'------------------------------------------------------------------------

Private Sub txtEmpFirst_Change()

'------------------------------------------------------------------------

    mblnChangeMade = True

End Sub

 

'------------------------------------------------------------------------

Private Sub txtEmpLast_GotFocus()

'------------------------------------------------------------------------

    SelectTextBoxText txtEmpLast

    intCurrTabIndex = txtEmpLast.TabIndex

    ValidateAllFields

End Sub

 

'------------------------------------------------------------------------

Private Sub txtEmpLast_KeyPress(KeyAscii As Integer)

'------------------------------------------------------------------------

 

    If KeyAscii < 32 Then Exit Sub

   

    KeyAscii = ValidKey(ConvertUpper(KeyAscii), gstrUPPER_ALPHA_PLUS)

   

End Sub

 

'------------------------------------------------------------------------

Private Sub txtEmpLast_Change()

'------------------------------------------------------------------------

    mblnChangeMade = True

End Sub

 

'------------------------------------------------------------------------

Private Sub cboDept_GotFocus()

'------------------------------------------------------------------------

    intCurrTabIndex = cboDept.TabIndex

    ValidateAllFields

End Sub

 

'------------------------------------------------------------------------

Private Sub cboDept_Click()

'------------------------------------------------------------------------

    mblnChangeMade = True

End Sub

 

'------------------------------------------------------------------------

Private Sub cboJob_GotFocus()

'------------------------------------------------------------------------

    intCurrTabIndex = cboJob.TabIndex

    ValidateAllFields

End Sub

 

'------------------------------------------------------------------------

Private Sub cboJob_Click()

'------------------------------------------------------------------------

 

    Dim objTempRst      As Recordset

   

    Set objTempRst = gobjEmpDB.OpenRecordset _

        ("SELECT MinRate, AvgRate, MaxRate FROM JobMast " _

       & "WHERE JobNbr = " & cboJob.ItemData(cboJob.ListIndex))

   

    'Note: The first record (and only record in this case) is

    'always current when a recordset is open - therefore, it is

    'not necessary to do "objTempRst.MoveFirst"

   

    'Load the Hourly Rate combo box with the min, avg, and max rates

    'for the selected job, and pre-select the avg rate ...

    With cboHrlyRate

        .Clear

        .AddItem Format$(objTempRst!MinRate, "Fixed")

        .AddItem Format$(objTempRst!AvgRate, "Fixed")

        .AddItem Format$(objTempRst!MaxRate, "Fixed")

        .ListIndex = 1

    End With

   

    Set objTempRst = Nothing

   

    mblnChangeMade = True

 

End Sub

 

'------------------------------------------------------------------------

Private Sub dtpHireDate_GotFocus()

'------------------------------------------------------------------------

    intCurrTabIndex = dtpHireDate.TabIndex

    ValidateAllFields

End Sub

 

'------------------------------------------------------------------------

Private Sub dtpHireDate_Change()

'------------------------------------------------------------------------

    mblnChangeMade = True

End Sub

 

'------------------------------------------------------------------------

Private Sub cboHrlyRate_GotFocus()

'------------------------------------------------------------------------

    intCurrTabIndex = cboHrlyRate.TabIndex

    ValidateAllFields

End Sub

 

'------------------------------------------------------------------------

Private Sub cboHrlyRate_Change()

'------------------------------------------------------------------------

    mblnChangeMade = True

End Sub

 

'------------------------------------------------------------------------

Private Sub cboHrlyRate_Click()

'------------------------------------------------------------------------

    mblnChangeMade = True

End Sub

 

'------------------------------------------------------------------------

Private Sub cboHrlyRate_LostFocus()

'------------------------------------------------------------------------

    cboHrlyRate.Text = Format$(cboHrlyRate.Text, "Fixed")

End Sub

 

'------------------------------------------------------------------------

Private Sub txtSchedHrs_GotFocus()

'------------------------------------------------------------------------

    SelectTextBoxText txtSchedHrs

    intCurrTabIndex = txtSchedHrs.TabIndex

    ValidateAllFields

End Sub

 

'------------------------------------------------------------------------

Private Sub txtSchedHrs_Change()

'------------------------------------------------------------------------

    mblnChangeMade = True

End Sub

 

'------------------------------------------------------------------------

Private Sub txtSchedHrs_KeyPress(KeyAscii As Integer)

'------------------------------------------------------------------------

 

    If KeyAscii < 32 Then Exit Sub

   

    KeyAscii = ValidKey(KeyAscii, gstrNUMERIC_DIGITS & ".")

   

    ' if text already has a decimal point, do not allow another ...

    If Chr$(KeyAscii) = "." And InStr(txtSchedHrs.Text, ".") > 0 Then

        KeyAscii = 0

    End If

   

End Sub

 

'------------------------------------------------------------------------

Private Sub txtSchedHrs_Validate(Cancel As Boolean)

'------------------------------------------------------------------------

    intCurrTabIndex = -1

    ValidateAllFields

    If mblnValidationError Then Cancel = True

End Sub

 

'------------------------------------------------------------------------

Private Sub txtSchedHrs_LostFocus()

'------------------------------------------------------------------------

    txtSchedHrs.Text = Format$(txtSchedHrs.Text, "Fixed")

End Sub

 

'------------------------------------------------------------------------

Private Sub txtCriteria_GotFocus()

'------------------------------------------------------------------------

    SelectTextBoxText txtCriteria

End Sub

 

'************************************************************************

'*                                                                      *

'*                          COMMAND BUTTON                              *

'*                         Event Procedures                             *

'*                                                                      *

'************************************************************************

 

'------------------------------------------------------------------------

Private Sub cmdFirst_Click()

'------------------------------------------------------------------------

 

    If mobjEmpRst.RecordCount = 0 Then Exit Sub

 

    mobjEmpRst.MoveFirst

    DisplayEmpRecord

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdNext_Click()

'------------------------------------------------------------------------

   

    If mobjEmpRst.RecordCount = 0 Then Exit Sub

 

    With mobjEmpRst

        .MoveNext

        If .EOF Then

            Beep

            .MoveLast

        End If

    End With

   

    DisplayEmpRecord

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdPrev_Click()

'------------------------------------------------------------------------

 

    If mobjEmpRst.RecordCount = 0 Then Exit Sub

 

    With mobjEmpRst

        .MovePrevious

        If .BOF Then

            Beep

            .MoveFirst

        End If

    End With

   

    DisplayEmpRecord

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdLast_Click()

'------------------------------------------------------------------------

 

    If mobjEmpRst.RecordCount = 0 Then Exit Sub

 

    mobjEmpRst.MoveLast

    DisplayEmpRecord

 

End Sub

 

 

'------------------------------------------------------------------------

Private Sub cmdAdd_Click()

'------------------------------------------------------------------------

 

    ClearTheForm

    ResetFormControls True, vbWhite

    mblnChangeMade = False

   

    If mobjEmpRst.RecordCount > 0 Then

        mvntBookMark = mobjEmpRst.Bookmark

    End If

 

    mobjEmpRst.AddNew

    'display the Access(JET)-generated autonumber ...

    lblEmpNbr.Caption = mobjEmpRst!EmpNbr

   

    mstrAction = "ADD"

    txtEmpFirst.SetFocus

    mblnOKToExit = False

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdUpdate_Click()

'------------------------------------------------------------------------

   

    If mobjEmpRst.RecordCount = 0 Then

        MsgBox "There are no records currently on file to update.", _

               vbInformation, "Update Record"

        Exit Sub

    End If

 

    ResetFormControls True, vbWhite

    mblnChangeMade = False

   

    mvntBookMark = mobjEmpRst.Bookmark

    mobjEmpRst.Edit

   

    mstrAction = "UPDATE"

    txtEmpFirst.SetFocus

    mblnOKToExit = False

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdDelete_Click()

'------------------------------------------------------------------------

 

    If mobjEmpRst.RecordCount = 0 Then

        MsgBox "There are no records currently on file to delete.", _

               vbInformation, "Delete Record"

        Exit Sub

    End If

 

    If MsgBox("Are you sure you want to delete this record?", _

              vbQuestion + vbYesNo + vbDefaultButton2, _

              "Delete Record") = vbNo Then

        Exit Sub

    End If

 

    mobjEmpRst.Delete

   

    If mobjEmpRst.RecordCount = 0 Then

        ClearTheForm

    Else

        cmdNext_Click

    End If

   

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdHelp_Click()

'------------------------------------------------------------------------

 

    gintHelpFileNbr = 2

    frmHelp.Show vbModal

   

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdExit_Click()

'------------------------------------------------------------------------

 

    Unload Me

   

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdSave_Click()

'------------------------------------------------------------------------

   

    intCurrTabIndex = -1

    ValidateAllFields

    If mblnValidationError Then Exit Sub

   

    With mobjEmpRst

        !EmpFirst = txtEmpFirst.Text

        !EmpLast = txtEmpLast.Text

        !DeptNbr = cboDept.ItemData(cboDept.ListIndex)

        !JobNbr = cboJob.ItemData(cboJob.ListIndex)

        !HireDate = dtpHireDate.Value

        !HrlyRate = Val(cboHrlyRate.Text)

        !SchedHrs = Val(txtSchedHrs.Text)

        .Update

        .Bookmark = .LastModified

    End With

   

    ResetFormControls False, vbButtonFace

    mblnOKToExit = True

   

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdUndo_Click()

'------------------------------------------------------------------------

 

    If Not mblnChangeMade Then Exit Sub

 

    If MsgBox("Do you want to abandon your changes to this record?", _

                  vbQuestion + vbYesNo, "Undo") = vbNo Then

        Exit Sub

    End If

 

    If mstrAction = "ADD" Then

        ClearTheForm

    Else

        DisplayEmpRecord

    End If

   

    mblnChangeMade = False

   

    txtEmpFirst.SetFocus

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdCancel_Click()

'------------------------------------------------------------------------

       

    If mblnChangeMade Then

        If MsgBox("Do you want to abandon your changes to this record?", _

                      vbQuestion + vbYesNo, "Undo") = vbNo Then

            Exit Sub

        End If

    End If

   

    If mobjEmpRst.RecordCount = 0 Then

        ClearTheForm

    Else

        mobjEmpRst.Bookmark = mvntBookMark

        DisplayEmpRecord

    End If

   

    ResetFormControls False, vbButtonFace

    mblnOKToExit = True

 

End Sub

 

'************************************************************************

'*                                                                      *

'*                      "SEARCH" FRAME CONTROLS                         *

'*                         Event Procedures                             *

'*                                                                      *

'************************************************************************

 

'------------------------------------------------------------------------

Private Sub cboRelOp_Click()

'------------------------------------------------------------------------

 

    If cboRelOp.Text = "Like" Then

        If cboField.Text = "First Name" Or cboField.Text = "Last Name" Then

            ' it's OK

        Else

            MsgBox "Comparison operator 'Like' may only be used with the " _

                 & "fields 'First Name' or 'Last Name'.", vbInformation, _

                 "Invalid Comparison Operator"

            cboRelOp.SetFocus

        End If

    End If

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdFind_Click(Index As Integer)

'------------------------------------------------------------------------

 

    Dim strFindString   As String

   

    ' perform this validation before moving on ...

    If cboField.Text = "Hire Date" Then

        If IsDate(txtCriteria.Text) Then

            txtCriteria.Text _

                = Format$(CDate(txtCriteria.Text), "m/d/yyyy")

        Else

            MsgBox "Criteria for 'Hire Date' is not valid.", _

                   vbExclamation, "Invalid Criteria"

            txtCriteria.SetFocus

            Exit Sub

        End If

    End If

   

    'save current rec's bookmark in case of NoMatch ...

    mvntBookMark = mobjEmpRst.Bookmark

   

    'start building the criteria string for the Find method with the field

    'name of the desired database field, based on the user's cboField selection ...

    Select Case cboField.Text

        Case "Emp #":           strFindString = "EmpNbr"

        Case "First Name":      strFindString = "EmpFirst"

        Case "Last Name":       strFindString = "EmpLast"

        Case "Dept #":          strFindString = "DeptNbr"

        Case "Job #":           strFindString = "JobNbr"

        Case "Hire Date":       strFindString = "HireDate"

        Case "Hourly Rate":     strFindString = "HrlyRate"

        Case "Sched. Wkly Hrs": strFindString = "SchedHrs"

    End Select

   

    'append the selected relational operator to the find string ...

    strFindString = strFindString & " " & cboRelOp.Text & " "

   

    'finally, append the value to search for to the find string ...

    If cboField.Text = "First Name" _

    Or cboField.Text = "Last Name" Then

        strFindString = strFindString _

                      & Chr$(34) & txtCriteria.Text & Chr$(34)

    ElseIf cboField.Text = "Hire Date" Then

        strFindString = strFindString _

                      & "#" & txtCriteria.Text & "#"

    Else

        strFindString = strFindString & Val(txtCriteria.Text)

    End If

   

    ' call the appropriate Find method, depending upon which

    ' button the user clicked ...

    Select Case Index

        Case 0: mobjEmpRst.FindFirst strFindString

        Case 1: mobjEmpRst.FindPrevious strFindString

        Case 2: mobjEmpRst.FindNext strFindString

        Case 3: mobjEmpRst.FindLast strFindString

    End Select

   

    ' deal with the match results ...

    If mobjEmpRst.NoMatch Then

        MsgBox "No (other) records matched your search criteria.", _

               vbInformation, "Not Found"

        mobjEmpRst.Bookmark = mvntBookMark

    Else

        ' the found record is now the current record ...

        DisplayEmpRecord

    End If

   

End Sub

 

 

'************************************************************************

'*                                                                      *

'*                        PROGRAMMER-DEFINED                            *

'*                 (Non-Event) Procedures & Functions                   *

'*                                                                      *

'************************************************************************

 

'------------------------------------------------------------------------

Private Sub LoadDeptCombo()

'------------------------------------------------------------------------

 

    Dim objTempRst  As Recordset

   

    Set objTempRst = gobjEmpDB.OpenRecordset("DeptMast", dbOpenTable)

    With objTempRst

        .MoveFirst

        Do Until .EOF

            cboDept.AddItem !DeptName & " (" & !DeptNbr & ")"

            cboDept.ItemData(cboDept.NewIndex) = !DeptNbr

            .MoveNext

        Loop

        .Close

    End With

 

    Set objTempRst = Nothing

 

End Sub

 

'------------------------------------------------------------------------

Private Sub LoadJobCombo()

'------------------------------------------------------------------------

 

    Dim objTempRst  As Recordset

   

    Set objTempRst = gobjEmpDB.OpenRecordset("JobMast", dbOpenTable)

    With objTempRst

        .MoveFirst

        Do Until .EOF

            cboJob.AddItem !JobTitle & " (" & !JobNbr & ")"

            cboJob.ItemData(cboJob.NewIndex) = !JobNbr

            .MoveNext

        Loop

        .Close

    End With

 

    Set objTempRst = Nothing

 

End Sub

 

'------------------------------------------------------------------------

Private Sub DisplayEmpRecord()

'------------------------------------------------------------------------

 

    Dim intX    As Integer

 

    With mobjEmpRst

        lblEmpNbr = !EmpNbr

        txtEmpFirst.Text = !EmpFirst

        txtEmpLast.Text = !EmpLast

        For intX = 0 To cboDept.ListCount - 1

            If !DeptNbr = cboDept.ItemData(intX) Then

                cboDept.ListIndex = intX

                Exit For

            End If

        Next

        For intX = 0 To cboJob.ListCount - 1

            If !JobNbr = cboJob.ItemData(intX) Then

                cboJob.ListIndex = intX         ' will invoke cboJob_Click event

                Exit For

            End If

        Next

        lblHireDate = Format$(!HireDate, "m/d/yyyy")

        dtpHireDate.Value = !HireDate

        cboHrlyRate.Text = Format$(!HrlyRate, "#0.00")

        txtSchedHrs.Text = Format$(!SchedHrs, "#0.00")

    End With

  

End Sub

 

'------------------------------------------------------------------------

Private Sub ResetFormControls(pblnEnabledValue As Boolean, lngColor As Long)

'------------------------------------------------------------------------

 

    Dim intX As Integer

 

    fraEmpInfoInner.Enabled = pblnEnabledValue

   

    txtEmpFirst.BackColor = lngColor

    txtEmpLast.BackColor = lngColor

    cboDept.BackColor = lngColor

    cboJob.BackColor = lngColor

   

    If pblnEnabledValue = True Then

        dtpHireDate.Value = CDate(lblHireDate)

    Else

        lblHireDate = Format$(dtpHireDate.Value, "m/d/yyyy")

    End If

   

    dtpHireDate.Visible = pblnEnabledValue

    lblHireDate.Visible = Not pblnEnabledValue

   

    cboHrlyRate.BackColor = lngColor

    txtSchedHrs.BackColor = lngColor

 

    cmdSave.Enabled = pblnEnabledValue

    cmdUndo.Enabled = pblnEnabledValue

    cmdCancel.Enabled = pblnEnabledValue

 

    cmdFirst.Enabled = Not pblnEnabledValue

    cmdNext.Enabled = Not pblnEnabledValue

    cmdPrev.Enabled = Not pblnEnabledValue

    cmdLast.Enabled = Not pblnEnabledValue

    cmdAdd.Enabled = Not pblnEnabledValue

    cmdUpdate.Enabled = Not pblnEnabledValue

    cmdDelete.Enabled = Not pblnEnabledValue

    cmdExit.Enabled = Not pblnEnabledValue

   

    fraSearchInner.Enabled = Not pblnEnabledValue

    cboField.BackColor = IIf(lngColor = vbWhite, vbButtonFace, vbWhite)

    cboRelOp.BackColor = IIf(lngColor = vbWhite, vbButtonFace, vbWhite)

    txtCriteria.BackColor = IIf(lngColor = vbWhite, vbButtonFace, vbWhite)

   

    For intX = 0 To 3

        cmdFind(intX).Enabled = Not pblnEnabledValue

    Next

 

    mblnOKToExit = False

 

End Sub

 

'------------------------------------------------------------------------

Private Sub ClearTheForm()

'------------------------------------------------------------------------

   

    txtEmpFirst.Text = ""

    txtEmpLast.Text = ""

    cboDept.ListIndex = 0                   'default to first Dept in the list

    cboJob.ListIndex = 0                    'default to first Job in the list

    lblHireDate = Format$(Date, "m/d/yyyy") 'default to today's date

    cboHrlyRate.ListIndex = 1               'default to the average rate

    txtSchedHrs.Text = "40.00"              'default to 40 hrs per week

   

End Sub

 

'------------------------------------------------------------------------

Private Sub ValidateAllFields()

'------------------------------------------------------------------------

 

    mblnValidationError = False

   

    '*** First Name

 

    If txtEmpFirst.Text = "" Then

        MsgBox "First Name must not be blank", _

               vbExclamation, "First Name"

        mblnValidationError = True

        Beep

        txtEmpFirst.SetFocus

    End If

   

    If intCurrTabIndex = txtEmpLast.TabIndex Or mblnValidationError Then

        Exit Sub

    End If

   

    '*** Last Name

    If txtEmpLast.Text = "" Then

        MsgBox "Last Name must not be blank", _

               vbExclamation, "Last Name"

        mblnValidationError = True

        Beep

        txtEmpLast.SetFocus

    End If

   

    If intCurrTabIndex = cboDept.TabIndex Or mblnValidationError Then

        Exit Sub

    End If

   

    '*** Department

    '   (no validation logic needed)

    

    If intCurrTabIndex = cboJob.TabIndex Or mblnValidationError Then

        Exit Sub

    End If

      

    '*** Job

    '   (no validation logic needed)

   

    If intCurrTabIndex = dtpHireDate.TabIndex Or mblnValidationError Then

        Exit Sub

    End If

 

    '*** Hire Date

    '   (no validation logic needed)

   

    If intCurrTabIndex = cboHrlyRate.TabIndex Or mblnValidationError Then

        Exit Sub

    End If

 

    '*** Hourly Rate

   

    If cboHrlyRate.Text = "" Then

        MsgBox "Hourly Rate must be entered.", _

               vbExclamation, "Hourly Rate"

        mblnValidationError = True

        Beep

        cboHrlyRate.SetFocus

    ElseIf Not IsNumeric(cboHrlyRate.Text) Then

        MsgBox "Hourly Rate must be numeric.", _

               vbExclamation, "Hourly Rate"

        mblnValidationError = True

        Beep

        cboHrlyRate.SetFocus

    ElseIf Val(cboHrlyRate.Text) <= 0 Then

        MsgBox "Hourly Rate must be greater than zero.", _

               vbExclamation, "Hourly Rate"

        mblnValidationError = True

        Beep

        cboHrlyRate.SetFocus

    End If

   

    If intCurrTabIndex = txtSchedHrs.TabIndex Or mblnValidationError Then

        Exit Sub

    End If

 

    '*** Scheduled Hours

 

    If txtSchedHrs.Text = "" Then

        MsgBox "Hours must be entered.", _

               vbExclamation, "Hours"

        mblnValidationError = True

        Beep

        txtSchedHrs.SetFocus

    ElseIf Val(txtSchedHrs.Text) <= 0 Then

        MsgBox "Hours must be greater than zero.", _

               vbExclamation, "Hours"

        mblnValidationError = True

        Beep

        txtSchedHrs.SetFocus

    End If

 

End Sub

 

The Report Menu Screen (frmReportMenu)

 

The Report Menu form, named "frmReportMenu", is shown below.  This form enables the user print either of the two available reports created for this application with Crystal Reports. This is the exact same form that was used in the Crystal Reports demo presents a couple of articles back. Refer to that article for an explanation of this form and the corresponding code.

 

 

 

 

 

Code for frmReportMenu

 

Option Explicit

 

'------------------------------------------------------------------------

Private Sub Form_Load()

'------------------------------------------------------------------------

    CenterForm Me

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdOK_Click()

'------------------------------------------------------------------------

 

    On Error GoTo cmdOK_Click_Error

   

    Dim strReportName           As String

    Dim intReportDestination    As Integer

   

    If optReport(0).Value = True Then

        strReportName = "SALDEPT.RPT"

    Else

        strReportName = "SALJOB.RPT"

    End If

   

    If optDestination(0).Value = True Then

        intReportDestination = crptToWindow

    Else

        intReportDestination = crptToPrinter

    End If

   

    With rptAnnSalExp

        .ReportFileName = GetAppPath() & strReportName

        .DataFiles(0) = GetAppPath() & "EMPLOYEE.MDB"

        .Destination = intReportDestination

        .Action = 1                ' 1 = "Run the Report"

    End With

   

    Exit Sub

 

cmdOK_Click_Error:

 

    MsgBox "The following error has occurred:" & vbNewLine _

         & Err.Number & " - " & Err.Description, _

           vbCritical, _

           "cmdOK_Click"

 

End Sub

 

'------------------------------------------------------------------------

Private Sub cmdExit_Click()

'------------------------------------------------------------------------

    Unload Me

End Sub

 

Download the project files for this sample application here.