Using DAO (Data Access Objects) Code

Level:
Level3

This tutorial describes how you can use DAO code directly within your VB6 application instead of being tied to a Visual Basic control.

Originally Written By TheVBProgramer.

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.

If you enjoyed this post, subscribe for updates (it's free)

IMS

nice ,,can you help me about the invenory system??Tnx

how can i make a (search in database) command on v.b 6.0

heeeeeeeeeeeeeeeeeeeelp plz

nice i learned a lot of

nice i learned a lot of things

VB help

I prepared one vb6 form with 3 text boxes and one command button and one data control and connect with database having one autonumber field and two text field.

when I enter into value to text box in autonumber field and add to database it display error of Data conversion err.

Can you any one help to me.

Autonumber Update

As the name suggest AUTONUMBER, it is incremented automatically. The database engine handels the autonumber field so you can not update it manually. Most probably you are using Microsoft Acess data base at your backend, Access generates the autonumber for the filed, so do not try to manipulate it. It keeps on incrementing automatically.

Thanks

i want to know how to do a

i want to know how to do a program in vb6.0 using microsoft windows common controls 6.0(sp6),microsoft DAO 6.0 object library, help me i want to submit my project before 17th of june.

Question

Codes used to print in vb

Great work - nice tutorial

I am new to VB. I found all the things from this one page what I needed. Great stuff. Keep it up !!!!!!!!!

KEep it up guyz!

Your site certainly helps a lot. tnx.

Awesome!!

Fabuluos piece of explanation with code samples. Some thing i would love to bookmark.

Nice

Great tutorial, and nice code...Everything needed to explain to someone just starting while also informational to someone not yet used to DAO syntax...

Thanks, and keep up the good work. :)

Pls. help me with this problem

I would like to know if how can I store the data inputted by the user from the textboxes to the recordset?...
also, I would like to know if what is the code to display the data onto the listview or in a form of a table?

Great work

This is a great refferencing material. Honestly A-Z of what i needed. keep up. and up-to-date.

One of the Most organized

One of the Most organized and informative sites i've ever seen.......thanks a lot for everything.....

pls help me with this problem

private sub cmddiv_click()

txtresult.text=val(txtn1.text) / val(txtn2.text)

End sub

What I really want this code to do is to divide numbers lets say 72 divide by 27 which will give 2.6666667 but what I want is that the result should be 2.67 that is there should be only two diugits after the decimal and last number should be approximated.
thanks

Reply

You need to change ur code a li'lbit as follows:-

Private Sub cmddiv_click()

txtresult.Text = Round(Val(txtn1.Text) / Val(txtn2.Text), 2)

End Sub

Happy to help u!

Format

try this

txtresult.text= format(val(txtn1.text) / val(txtn2.text)), "####.##")

re

Dim ans as double
ans = val(txtn1)/val(txtn2)
txtresult = ans