
Although you have a choice of database formats, such as indexed sequential access method (ISAM) or Open Database Connectivity (ODBC) drivers, you will find it easiest to work with Visual Basic's "native" database format, Microsoft Access. Because Visual Basic and Microsoft Access have been created to work in tandem, you have a rich feature set available to you. This chapter shows you how to use many of the unique features of Microsoft Access database files.
A Microsoft Access database contains information about each table in the database--including, among other items, when the table was created, when it was last modified, and the number of records it currently contains. This How-To consists of a tool for extracting and displaying that information.
In some cases, it is necessary or desirable to make the contents of a table available to more than one Microsoft Access database. A database can access a table from another database by attaching the table to itself. This How-To shows you how to attach Microsoft Access tables to Microsoft Access databases through Visual Basic.
The source of your application's data might be files consisting of delimited ASCII or ANSI text. This How-To shows how to use Visual Basic classes and collections to convert text files into records that you can add to Microsoft Access tables.
The capability to store graphics in a database can be very useful, but sometimes challenging. This How-To explains two methods of saving graphics, as well as providing an example of one of them.
A well-designed relational database uses multiple tables that are related. A single "logical" add, delete, or update operation often requires making a change to more than one table. If an error occurs during a multitable operation, you generally want to abort the entire operation and return all the tables to the condition in which they existed at the start of the operation. This How-To shows how to use the transaction features of the Jet database engine to ensure the integrity of your tables.
The Jet database engine has the capability to recover space after deletion of data, but it does not perform the operation automatically. The Jet engine also can repair certain types of database damage--but again, it will not make the attempt unless it is instructed to do so. This How-To shows how to use Visual Basic to initiate the Jet engine's database-compact and database-repair capabilities.
Microsoft Access queries can be designed to use replaceable parameters. A query with a replaceable parameter must be provided with a value for that parameter each time the query is run. This How-To shows how to use stored queries with replaceable parameters from Visual Basic.
Problem
I have an application that periodically adds records to a table. No other user or application ever modifies this table. To make sure that I don't perform the same update twice, I'd like to check the current record count and the date the last changes were made to the table's recordset. How can I do this from Visual Basic?
Technique
The TableDefs collection of the Database object consists of TableDef objects, each of which represents one table from the database. The properties of the TableDef object describe the table. Table 5.1 lists the properties of TableDef objects applicable to native Microsoft Access database tables.
| PROPERTY | DESCRIPTION |
| Attributes | Characteristics of the table, including whether the table is an attached table |
| DateCreated | The date and time the table was created |
| LastUpdated | The date and time the table was most recently changed |
| Name | The name of the table |
| RecordCount | The number of records in the table |
| SourceTableName | The name of the base table, if the TableDef is for an attached table |
| Updatable | Specification of whether SourceTableName, ValidationRule, and ValidationText properties of the TableDef can be modified |
| ValidationRule | An expression used to set the criteria for accepting a new record or a modification to an existing record |
| ValidationText | The message returned if a change fails to meet the ValidationRule criteria |
Steps
The Table Status application displays four of the most useful properties for each user table in a database. Open and run TableData.VBP. You'll see a standard Windows File Open dialog box. Choose a Microsoft Access (*.MDB) file, and click OK. The form shown in Figure 5.1 appears with a list of the tables in the database shown in the list box. After you select a table, the table's creation date, last modification date, and current record count appear in the boxes on the form, similar to Figure 5.2.
Figure 5.1. The table statistics form on startup.
Figure 5.2. The table statistics form with the statistics from the Title Author table shown.
Table 5.2. Objects and properties for the Table Status form.
OBJECT PROPERTY SETTING Form Name Form1 Caption "Chapter 5.1 Example" CommandButton Name cmdChangeFile Caption "Change &File" CommandButton Name cmdExit Cancel True Caption "E&xit" ListBox Name lstTables Sorted True CommonDialog Name cdlTableData CancelError True DefaultExt "MDB" DialogTitle "Database File" FileName "*.MDB" Filter "*.MDB" Label Name lblCreated Alignment 2 (Center) BorderStyle 1 (Fixed Single) Label Name lblModified Alignment 2 (Center) BorderStyle 1 (Fixed Single) Label Name lblRecords Alignment 2 (Center) BorderStyle 1 (Fixed Single) Label Name lblTableData Index 0 Caption "Created:" Label Name lblTableData Index 1 Caption "Last Modified:" Label Name lblTableData Index 2 Caption "Records:"
Option Explicit
Private colTableData As Collection
Private Sub Form_Load()
GetDatabase
End Sub
Private Sub GetDatabase()
Dim dbfTableData As Database
Dim tdfTables As TableDefs, tdfSelectedTable As TableDef
Dim objTable As clsTableData
Dim strDatabaseName As String
On Error GoTo NoDatabaseError
`Call the ShowOpen method of the CommonDialog control, so
`the user can select a database.
cdlTableData.ShowOpen
On Error GoTo GetDatabaseError
strDatabaseName = cdlTableData.filename
Screen.MousePointer = vbHourglass
`Open the chosen database
Set dbfTableData = _
DBEngine.Workspaces(0).OpenDatabase( _
strDatabaseName, False, True)
`Fetch the TableDefs collection & place in a local
`variable. This has the benefit of slightly faster
`processing
Set tdfTables = dbfTableData.TableDefs
`Set up the collection class we're using, so new
`instances of our clsTableData class can be stored in
`it.
Set colTableData = New Collection
`For each TableDef in TableDefs, use the clsTableData
`to get the needed info from the table, and place the
`table's name and its index within the collection in
`the list box.
For Each tdfSelectedTable In tdfTables
If Left$(tdfSelectedTable.Name, 4) <> "MSys" Then
Set objTable = New clsTableData
objTable.ExtractStatusData tdfSelectedTable
colTableData.Add objTable
With lstTables
.AddItem objTable.Name
.ItemData(lstTables.NewIndex) = _
colTableData.Count
End With
End If
Next
`Now that it's not needed, close the database.
dbfTableData.Close
On Error GoTo 0
Screen.MousePointer = vbDefault
On Error GoTo 0
Exit Sub
NoDatabaseError:
`If the user didn't select a database, end the application.
End
GetDatabaseError:
Screen.MousePointer = vbDefault
MsgBox Err.Description, vbExclamation
End
End Sub
Private Sub lstTables_Click()
Dim objTable As clsTableData, intPosition As Integer
`Get the ItemData from the list, the index of the selected
`clsTableData stored in our collection.
intPosition = lstTables.ItemData(lstTables.ListIndex)
`Using this index, fetch our selected instance of
`clsTableData.
Set objTable = colTableData.Item(intPosition)
`Read the properties of our class into the labels
lblCreated = Format$(objTable.WhenCreated, "General Date")
lblModified = Format$(objTable.WhenModified, "General Date")
lblRecords = objTable.NumRecords
End Sub
Private Sub cmdChangeFile_Click()
`Clear out the form, and flush the existing collection.
lstTables.Clear
lblCreated = "": lblModified = "": lblRecords = ""
Set colTableData = Nothing
`Reset our CommonDialog control, and get another database.
cdlTableData.filename = "*.MDB"
GetDatabase
End Sub
Private Sub cmdExit_Click()
End
End Sub
Option Explicit `Module-level variables used to hold property values. They are `not accessible, or not "exposed," outside of the class directly. `Property Get statements are used to "expose" this data to other `objects that may request it. Private mlngNumRecords As Long Private mdatWhenModified As Date Private mdatWhenCreated As Date Private mstrName As String
Public Sub ExtractStatusData(tblDef As TableDef)
`This subroutine retrieves the property data from a given
`TableDef.
mstrName = tblDef.Name
mdatWhenModified = tblDef.LastUpdated
mdatWhenCreated = tblDef.DateCreated
mlngNumRecords = tblDef.RecordCount
End Sub
Property Get Name() As String
Name = mstrName
End Property
Property Get NumRecords() As Long
NumRecords = mlngNumRecords
End Property
Property Get WhenModified() As Date
WhenModified = mdatWhenModified
End Property
Property Get WhenCreated() As Date
WhenCreated = mdatWhenCreated
End Property
How It Works
When the application's only form loads, it calls the GetDatabase procedure, which uses the Windows common dialog to prompt the user to enter the name of the database to be examined. It then opens the database and the TableDefs collection of the database, cycling through the TableDefs collection and examining each TableDef object in the collection to see whether it represents a system table or a user-defined table. If it is a user-defined table, GetDatabase creates a new clsTableData object and points the variable objTable to the object. The clsTableData object extracts four properties from the TableDef object. These TableDef properties become the properties of the clsTableData object. GetDatabase then adds the clsTableData object to the colTableData. When all the TableDef objects in the TableDefs collection have been examined, GetDatabase closes the database. It then cycles through the clsTableData objects in the colTableData and adds the name of each table in the collection to the list box.
When the user clicks on a table name in the list box, the Click routine extracts the information about the chosen table from the clsTableData object in colTableData and displays the information on the form.
Comments
Each Microsoft Access database includes a set of system tables that maintain information about the objects in the database. These tables all have names beginning with "MSys." You can access some of these tables directly. The tables are not documented and, therefore, are subject to change in a new release of Access, so it's generally not a good idea to build an application that relies on direct access to the MSys tables. Fortunately, the TableDefs object described in this How-To gives you a documented way to get at much of the most useful information in these system tables, including status information on each table in the database.
Question
My application has a Microsoft Access database file with several tables that it "owns." But it also needs to work with data in a table that resides in another Microsoft Access file, a table that my application must share with other applications. How can I use a table in a different Microsoft Access file?
Technique
A "database" in older PC database products (such as dBASE, FoxPro, and Paradox products) consists of multiple files--data files, index files, form files, report files, procedure files, and so on. Microsoft Access, on the other hand, uses a single file, into which it incorporates multiple objects--data objects (tables), queries, indexes, forms, reports, macros, and Access Basic code modules. The "database" is a single file.
In most situations, the Microsoft Access way is better. This method eases system administration and makes it less likely that a needed file will be inadvertently moved or deleted. But it's not an advantage when multiple applications each maintain separate databases--and, therefore, separate database files--and the applications also need to share some common data.
Microsoft Access provides the capability to share data between separate databases through the use of attached tables. Attaching a table creates a link between a database file and a table that physically resides in a different file. When you attach a table to a Microsoft Access database, you can treat that table very much like you treat the internal tables of the database--with a few restrictions.
The major restriction in working with attached tables is that you cannot use them with table-type recordsets--you can use only dynaset- or snapshot-type recordsets. Because you cannot work with attached table-type recordsets, you cannot use the Seek method to access data. The Seek method is usually the fastest way to randomly access data from a single table, so this might or might not be a significant restriction, depending on the needs of your application. (See the introduction to Chapter 3, "Creating Queries with SQL," for a discussion of the conditions under which the Seek method provides faster access than the use of SQL SELECT queries.)
Attaching Tables
Each Microsoft Access database file contains a set of table definitions. When you create a Database object and connect a database file to that object, the file's table definitions constitute the TableDefs collection of the Database object. If tables have been attached to the database, the TableDefs collection includes TableDef objects for each attached table; one of the properties of the TableDef object indicates that it is an attached table. For more detailed information on the steps needed to attach a table in a Microsoft Access database, be sure to closely follow step 5 in this How-To.
Steps
Open the project ATTACH.VBP and then run the project. The form shown in Figure 5.3 appears. Click Attach a Table and a standard File Open dialog box appears. Select a Microsoft Access database file to which you want to attach a table (the destination file), and then select the source file for the table (you must select different files). After you have selected both files, the form shown in Figure 5.4 appears with a list of the tables in the source file. Select a table from the list and click OK. A message appears indicating successful attachment, and then the form shown in Figure 5.3 reappears.
Figure 5.3. The attach and detach table example on startup.
Click Detach a Table and select the same file you used as the destination file when you attached a table. The form shown in Figure 5.4 appears again, this time listing the attached tables in the selected file. Select the table you just attached, and click OK.
Figure 5.4. The project's Table List form, showing table names.
Table 5.3. Objects and properties for frmAttach.
OBJECT PROPERTY SETTING Form Name frmAttach Caption "Chapter 5.2 Example" CommandButton Name cmdAttach Caption "&Attach a Table" CommandButton Name cmdDetach Caption "&Detach a Table" CommandButton Name cmdClose Caption "&Close" CommonDialog Name cdlFile
Table 5.4. Objects and properties for frmSelector.
OBJECT PROPERTY SETTING Form Name frmSelector ListBox Name lstBox Label Name lblList Caption "" CommandButton Name cmdOK Caption "&OK" Default True CommandButton Name cmdCancel Cancel True Caption "&Cancel"
Public Function GetFileName(ByVal strFullPath As String) As String
Dim I As Integer, strTemp As String
If Len(strFullPath) Then
For I = Len(strFullPath) To 1 Step -1
If Mid(strFullPath, I) = "\" Then strTemp = _
Right(strFullPath, Len(strFullPath) - I)
Next
If strTemp = "" Then strTemp = strFullPath
End If
GetFileName = strTemp
End Function
Option Explicit Const SOURCE_FILE = 1 Const DESTINATION_FILE = 2 Const DETACH_FILE = 3
Private Sub cmdAttach_Click()
Static strSourceFile As String, strDestFile As String
Dim strTableName As String
Dim dbfAttach As Database, tdfAttach As TableDef
strDestFile = GetMDBFile(DESTINATION_FILE)
If Len(strDestFile) Then strSourceFile = _
GetMDBFile(SOURCE_FILE)
If Len(strSourceFile) Then
`Call the custom method, Display, from frmSelector. This
`will return either "" or the name of a selected table.
strTableName = frmSelector.Display(True, strSourceFile)
On Error GoTo BadAttach
If Len(strTableName) Then
`If we have a table, let's attach it.
Set dbfAttach = _
Workspaces(0).OpenDatabase(strDestFile)
`Generate a TableDef object
Set tdfAttach = _
dbfAttach.CreateTableDef(strTableName)
`Provide the connection info
tdfAttach.Connect = ";DATABASE=" & strSourceFile
`Provide the table's name
tdfAttach.SourceTableName = strTableName
`Append it to the database's TableDefs collection
dbfAttach.TableDefs.Append tdfAttach
`And it's good!
MsgBox "Table " & strTableName & _
" attached to " & _
GetFileName(strDestFile) & "."
End If
On Error GoTo 0
End If
Exit Sub
BadAttach:
MsgBox Err.Description, vbExclamation
End Sub
Private Sub cmdDetach_Click()
Static strDetachFile As String
Dim strTableName As String
Dim dbfDetach As Database
strDetachFile = GetMDBFile(DETACH_FILE)
`Call frmSelector's Display method
If Len(strDetachFile) Then strTableName = _
frmSelector.Display(False, strDetachFile)
On Error GoTo BadDetach
If Len(strTableName) Then
`If we have a table, then detach it.
Set dbfDetach = _
Workspaces(0).OpenDatabase(strDetachFile)
dbfDetach.TableDefs.Delete strTableName
MsgBox "Table " & strTableName & " detached from " & _
GetFileName(strDetachFile) & "."
End If
On Error GoTo 0
Exit Sub
BadDetach:
MsgBox Err.Description, vbExclamation
End Sub
Private Function GetMDBFile(intPurpose As Integer) As String
On Error GoTo GetMDBFileError
Select Case intPurpose
Case SOURCE_FILE
cdlFile.DialogTitle = _
"Select Source File For Attach"
Case DESTINATION_FILE
cdlFile.DialogTitle = _
"Select Destination File For Attach"
Case DETACH_FILE
cdlFile.DialogTitle = _
"Select Source File For Detach"
End Select
With cdlFile
.DefaultExt = "*.MDB"
.Filter = "Access Files *.MDB|*.MDB|All Files *.*|*.*"
`The user must select an existing file.
.Flags = cdlOFN_FILEMUSTEXIST
.CancelError = True
.filename = "*.MDB"
.ShowOpen
End With
GetMDBFile = cdlFile.filename
On Error GoTo 0
Exit Function
GetMDBFileError:
Exit Function
End Function
Private Function ExtractPath(fileName As String, fullPath As String)
ExtractPath = Left$(fullPath, _
Len(fullPath) - (Len(fileName) + 1))
End Function
Private Sub cmdClose_Click()
End
End Sub
Option Explicit
Private Function ListTables(blnAttach As Boolean, _
strFileSpec As String) _
As Integer
Dim dbfTemp As Database, tdfTemp As TableDef
Dim intTablesAdded As Integer
lstBox.Clear
On Error GoTo ListTablesError
Screen.MousePointer = vbHourglass
Set dbfTemp = _
DBEngine.Workspaces(0).OpenDatabase(strFileSpec)
intTablesAdded = 0
For Each tdfTemp In dbfTemp.TableDefs
If blnAttach Then
If Left$(tdfTemp.Name, 4) <> "MSys" And _
tdfTemp.Attributes <> dbAttachedTable And _
tdfTemp.Attributes <> dbAttachSavePWD And _
tdfTemp.Attributes <> dbAttachExclusive Then
lstBox.AddItem tdfTemp.Name
intTablesAdded = intTablesAdded + 1
End If
ElseIf tdfTemp.Attributes = dbAttachedTable Or _
tdfTemp.Attributes = dbAttachSavePWD Or _
tdfTemp.Attributes = dbAttachExclusive Then
lstBox.AddItem tdfTemp.Name
intTablesAdded = intTablesAdded + 1
End If
Next
Screen.MousePointer = vbDefault
ListTables = intTablesAdded
Exit Function
ListTablesError:
Screen.MousePointer = vbDefault
MsgBox Err.Description, vbExclamation
ListTables = 0
Exit Function
End Function
Public Function Display(ByVal blnAttach As Boolean, _
ByVal strFileSpec As String) As String
With Me
.Caption = "Table to " & IIf(blnAttach, "Attach", _
"Detach")
.lblList = "Select table to " & _
IIf(blnAttach, "attach:", "detach:")
End With
If ListTables(blnAttach, strFileSpec) Then
Me.Show vbModal
Else
MsgBox "There are no attached tables in " & _
GetFileName(strFileSpec) & "."
End If
If lstBox.ListIndex > -1 Then Display = lstBox.Text
End Function
Private Sub cmdOK_Click()
If lstBox.ListIndex > -1 Then
frmSelector.Hide
Else
MsgBox "You have not yet made a selection.", vbExclamation
End If
End Sub
Private Sub lstBox_DblClick()
cmdOK_Click
End Sub
Private Sub cmdCancel_Click()
lstBox.ListIndex = -1
frmSelector.Hide
End Sub
How It Works
When the user clicks the Attach a Table button, the Click event uses the Windows File Open common dialog box to get the destination and source files for the attachment. It then calls the Display method of frmSelector, setting blnAttach to True to indicate that frmSelector is to display those tables eligible for attachment from the designated source file. When the user makes a selection in frmSelector, the subroutine creates a new TableDef object and appends it to the destination file's TableDefs collection.
When the user clicks Detach a Table, the Click event uses the Windows File Open common dialog box to get the file from which the table is to be detached. It then calls the Display method of frmSelector again, setting blnAttach to False to indicate that frmSelector is to display the attached tables in the designated file. When the user makes a selection in frmSelector, the subroutine removes the selected TableDef object from the designated file's TableDefs collection.
Comments
The capability to attach external tables opens a lot of possibilities for the Visual Basic database application developer. The DAO engine is capable of providing many services that would otherwise be inconvenient to duplicate with extensive ODBC-related code, with a familiar object hierarchy. Also, when you need to import and export data, the capability to attach tables comes in very handy, making a sometimes tedious process of reading from one database and writing to another a snap. At a client/server level, the flexibility granted by the capability to attach tables from several different external database platforms allows for an ease of data access, whether for mainframe databases, server databases, or even several locally accessed workstation databases, without having to program for each database platform.
Problem
I periodically get downloads from a mainframe database (or other source) as delimited text files that I need to import into my database. If I could be sure that users had Microsoft Access installed, my program could use OLE to invoke the import capability of Access--but some users might not have a copy of Access. How can I use Visual Basic to import text files into a database file?
Technique
Visual Basic has a rich variety of features for working with text files. You can employ these capabilities to open the text file and read the text data. From that point, the problem resolves to using the delimiters in the text file to split the text into records and fields and storing the data in the appropriate database tables. You need to be prepared to handle errors, both the normal data access errors and any errors that incorrect input text might cause.
Steps
This How-To uses text data from the text files VENDORS.DAT and INVOICES.DAT imported into a Microsoft Access database, ACCTSPAY.MDB. The text files use an end-of-line sequence (a carriage return followed by a line feed) as a record delimiter and a tab character as a field delimiter. The Vendors table in the ACCTPAY.MDB has the following fields, with [Vendor Number] as the primary key:
The Invoices table in the database has the following fields. The primary key is a composite of [Vendor Number] and [Invoice Number].
The tables are related on the [Vendor Number] field; every record in the Invoices table must have a corresponding record in the Vendors table.
Open and run TextImport.VBP. You'll see the form shown in Figure 5.5. Click the Import Data button, and the application imports the contents of the text files VENDORS.DAT and INVOICES.DAT into the Vendors and Invoices tables of ACCTSPAY.MDB. Click List Vendors, and a list of the vendors imported appears in the list box at the top of the form. Select a vendor name; if any invoices for that vendor were imported, a list of the invoices appears in the grid control at the bottom of the form. With a vendor selected, click Vendor Details, and you'll see the vendor details form shown in Figure 5.6.
Figure 5.5. The program's Text Import form on startup.
Figure 5.6. The program's Vendor Details form, showing vendor information.
Table 5.5. Objects and properties for the Vendor Details form.
OBJECT PROPERTY SETTING Form Name frmVendorDetails Caption "Chapter 5.3 Example - Vendor Details " Label Name lblNumber BorderStyle 1 (Fixed Single) Caption "" Label Name lblName BorderStyle 1 (Fixed Single) Caption "" Label Name lblAddress BorderStyle 1 (Fixed Single) Caption "" Label Name lblFEIN BorderStyle 1 (Fixed Single) Caption "" Label Name lblVendor Index 0 Caption "Vendor Number:" Label Name lblVendor Index 1 Caption "Vendor Name:" Label Name lblVendor Index 2 Caption "Vendor Address:" Label Name lblVendor Index 3 Caption "Vendor FEIN:" CommandButton Name cmdClose Caption "&Close" Default True
Private Sub cmdClose_Click()
Unload frmVendorDetails
End Sub
Table 5.6. Objects and properties for the main Text Import form.
OBJECT PROPERTY SETTING Form Name frmMain Caption "Chapter 5.3 Example" ListBox Name lstVendors Sorted True MSFlexGrid Name grdInvoices Cols 4 Scrollbars 2 - flexScrollBarVertical CommandButton Name cmdImport Caption "&Import Data" CommandButton Name cmdListVendors Caption "&List Vendors" CommandButton Name cmdVendorDetails Caption "&Vendor Details" CommandButton Name cmdExit Cancel True Caption "Exit"
Option Explicit `Change this constant to whatever path you have installed the `CD contents into. Const DATA_PATH = "D:\VB6DBHT" Private VendorFile As String, InvoiceFile As String, DatabaseFile As String
Private Sub Form_Load()
Dim dbfTemp As Database
`Assign fully qualified pathnames to the form level data file
`variables.
VendorFile = DATA_PATH & "\CHAPTER05\VENDORS.DAT"
InvoiceFile = DATA_PATH & "\CHAPTER05\INVOICES.DAT"
DatabaseFile = DATA_PATH & "\CHAPTER05\ACCTSPAY.MDB"
` Initialize the grid control.
InitializeGrid
` Delete any existing data in the Vendors and Invoices tables.
Set dbfTemp = _
DBEngine.Workspaces(0).OpenDatabase(DatabaseFile)
dbfTemp.Execute ("DELETE Vendors.* from Vendors")
dbfTemp.Execute ("DELETE Invoices.* from Invoices")
End Sub
Private Sub InitializeGrid()
With grdInvoices
.ColWidth(0) = 0:
.ColWidth(1) = 1300
.ColWidth(2) = 1300
.ColWidth(3) = 1300
.ColAlignment(1) = flexAlignLeftCenter
.ColAlignment(2) = flexAlignCenterCenter
.ColAlignment(3) = flexAlignRightCenter
.FixedAlignment(1) = flexAlignLeftCenter
.FixedAlignment(2) = flexAlignCenterCenter
.FixedAlignment(3) = flexAlignRightCenter
.Row = 0
.Col = 1: .Text = "Inv #"
.Col = 2: .Text = "Date"
.Col = 3: .Text = "Amount"
.Rows = 1
End With
End Sub
Private Sub cmdImport_Click()
Dim dbfTemp As Database, tblVendors As Recordset, tblInvoices _
As Recordset
Dim objVendor As clsVendor, objInvoice As clsInvoice
Dim colVendors As New Collection, colInvoices _
As New Collection
Dim strInputLine As String, strErrMsg As String
Dim blnNeedRollback As Boolean
Dim intFileHandle As Integer
On Error GoTo ImportTextError
Screen.MousePointer = vbHourglass
`Get the vendor text file, and create an instance
`of objVendor for each line found in the text file,
`passing the line to the DelimitedString property
`of the instance of objVendor.
intFileHandle = FreeFile
Open VendorFile For Input As intFileHandle
Do Until EOF(intFileHandle)
Line Input #intFileHandle, strInputLine
Set objVendor = New clsVendor
objVendor.DelimitedString = strInputLine
colVendors.Add objVendor
Loop
Close intFileHandle
`Same as above, but with the invoice text file.
intFileHandle = FreeFile:
Open InvoiceFile For Input As intFileHandle
Do Until EOF(intFileHandle)
Line Input #intFileHandle, strInputLine
Set objInvoice = New clsInvoice
objInvoice.DelimitedString = strInputLine
colInvoices.Add objInvoice
Loop
Close intFileHandle
`Prepare for addition
Set dbfTemp = _
DBEngine.Workspaces(0).OpenDatabase(DatabaseFile)
Set tblVendors = _
dbfTemp.OpenRecordset("Vendors", dbOpenTable)
Set tblInvoices = _
dbfTemp.OpenRecordset("Invoices", dbOpenTable)
`This is where we start the transaction processing. None
`of the changes we make will be committed to the database
`until the CommitTrans line, some lines below.
Workspaces(0).BeginTrans
blnNeedRollback = True
`Iterate through our collection of clsVendor objects,
`calling the StoreNewItem method and passing our newly
`opened table.
If colVendors.Count Then
For Each objVendor In colVendors
If objVendor.StoreNewItem(tblVendors) = False Then
strErrMsg = _
"An error occurred while importing vendor #" & _
CStr(objVendor.Number)
Err.Raise 32767
End If
Next
End If
`Same as above, but for invoices. (Deja vu...?)
If colInvoices.Count Then
For Each objInvoice In colInvoices
If objInvoice.StoreNewItem(tblInvoices) = False
Or objInvoice.VendorNumber = 0 Then
strErrMsg = _
"An error occurred while importing invoice #" & _
objInvoice.InvoiceNumber
Err.Raise 32767
End If
Next
End If
`Here's where the data is committed to the database.
`Had an error occurred, we would never reach this point;
`instead, the Rollback command in our error
`trapping routine would have removed our changes.
Workspaces(0).CommitTrans
Screen.MousePointer = vbDefault
On Error GoTo 0
Exit Sub
ImportTextError:
Screen.MousePointer = vbDefault
If strErrMsg = "" Then strErrMsg = _
"The following error has occurred:" & vbCr _
& Err.Description
strErrMsg = strErrMsg & _
" No records have been added to the database."
MsgBox strErrMsg, vbExclamation
`Here's the Rollback method; if the blnNeedRollback variable
`is still set to True, we undo our uncommitted changes.
If blnNeedRollback Then Workspaces(0).Rollback
Exit Sub
End Sub
Private Sub cmdListVendors_Click()
Dim dbfTemp As Database, tblVendors As Recordset
On Error GoTo ListVendorsError
Set dbfTemp = _
DBEngine.Workspaces(0).OpenDatabase(DatabaseFile, _
False, True)
Set tblVendors = dbfTemp.OpenRecordset("Vendors", dbOpenTable)
If tblVendors.RecordCount <> 0 Then
tblVendors.MoveFirst
Do Until tbl.EOF
lstVendors.AddItem tblVendors!Name
lstVendors.ItemData(lstVendors.NewIndex) = _
tblVendors![Vendor Number]
tblVendors.MoveNext
Loop
End If
tblVendors.Close
Exit Sub
ListVendorsError:
lstVendors.Clear
MsgBox Err.Description
End Sub
Private Sub lstVendors_Click()
FillInvoiceList lstVendors.ItemData(lstVendors.ListIndex)
End Sub
Private Sub FillInvoiceList(intVendor As Integer)
Dim dbfTemp As Database, recInvoices As Recordset
Dim intRow As Integer, strSQL As String
Dim colInvoices As New Collection, objInvoice As clsInvoice
On Error GoTo FillInvoiceListError
`Open the database & recordset used to fill the list box
Set dbfTemp =
DBEngine.Workspaces(0).OpenDatabase(DatabaseFile, _
False, True)
strSQL = "SELECT [Invoice Number] FROM Invoices " & _
"WHERE [Vendor Number] = " & intVendor
Set recInvoices = _
dbfTemp.OpenRecordset(strSQL, dbOpenSnapshot)
If recInvoices.RecordCount > 0 Then
recInvoices.MoveFirst
Do Until recInvoices.EOF
Set objInvoice = New clsInvoice
If objInvoice.Retrieve(dbfTemp, intVendor, _
recInvoices("Invoice Number")) _
Then colInvoices.Add objInvoice
recInvoices.MoveNext
Loop
grdInvoices.Rows = colInvoices.Count + 1
For intRow = 1 To colInvoices.Count
Set objInvoice = colInvoices(intRow)
objInvoice.AddToGrid grdInvoices, intRow
Next intRow
Else
grdInvoices.Rows = 1
End If
On Error GoTo 0
Exit Sub
FillInvoiceListError:
grdInvoices.Rows = 1: lstVendors.ListIndex = -1
MsgBox Err.Description, vbExclamation
Exit Sub
End Sub
Private Sub cmdVendorDetails_Click()
Dim dbfTemp As Database
Dim tblVendors As Recordset
Dim intVendorNumber As Integer
On Error GoTo VendorDetailsError
If lstVendors.ListIndex > -1 Then
intVendorNumber =
lstVendors.ItemData(lstVendors.ListIndex)
Set dbfTemp =
DBEngine.Workspaces(0).OpenDatabase(DatabaseFile, _
False, True)
Set tblVendors = dbfTemp.OpenRecordset("Vendors", _
dbOpenTable)
tblVendors.Index = "PrimaryKey"
tblVendors.Seek "=", intVendorNumber
With frmVendorDetails
.lblNumber = tblVendors![Vendor Number]
.lblName = IIf(IsNull(tblVendors!Name), "", _
tblVendors!Name)
.lblAddress = IIf(IsNull(tblVendors!Address), "", _
tblVendors!Address)
.lblFEIN = IIf(IsNull(tblVendors!FEIN), "", _
tblVendors!FEIN)
End With
tblVendors.Close
frmVendorDetails.Show vbModal
Else
Beep
MsgBox "You haven't selected a vendor.", vbExclamation
End If
On Error GoTo 0
Exit Sub
VendorDetailsError:
MsgBox Error(Err)
Exit Sub
End Sub
Private Sub cmdExit_Click()
End
End Sub
Option Explicit Private mintNumber As Integer Private mstrCompany As String Private mstrAddress As String Private mstrFEIN As String Private mstrDelimitedString As String
Property Let DelimitedString(strInput As String)
Dim strDelimiter As String, strTextNumber As String
Dim intEnd As Integer, intField As Integer, intStart As _
Integer
Dim I As Integer
strDelimiter = Chr$(9): mstrDelimitedString = strInput
intStart = 1: intField = 1
Do
intEnd = InStr(intStart, strInput, strDelimiter)
If intEnd = 0 Then intEnd = Len(strInput) + 1
Select Case intField
Case 1
strTextNumber = ExtractField(intStart, intEnd)
If IsNumeric(strTextNumber) Then
If strTextNumber >= 1 And _
strTextNumber <= 32767 Then
mintNumber = Val(strTextNumber)
Else
mintNumber = 0
End If
Else
mintNumber = 0
End If
Case 2
mstrCompany = ExtractField(intStart, intEnd)
Case 3
mstrAddress = ExtractField(intStart, intEnd)
Case 4
mstrFEIN = ExtractField(intStart, intEnd)
End Select
intStart = intEnd + 1: intField = intField + 1
Loop While intEnd < Len(strInput) And intField <= 4
End Property
Private Function ExtractField(intStart As Integer, intEnd As
Integer)
ExtractField = Mid$(mstrDelimitedString, intStart, _
(intEnd - intStart))
End Function
Public Function StoreNewItem(rs As Recordset) As Boolean
On Error GoTo StoreNewError
rs.AddNew
If WriteItem(rs) Then
rs.Update
Else
GoTo StoreNewError
End If
StoreNewItem = True
On Error GoTo 0
Exit Function
StoreNewError:
StoreNewItem = False
Exit Function
End Function
Private Function WriteItem(recTemp As Recordset) As Boolean
On Error GoTo WriteItemError
recTemp("Vendor Number") = mintNumber
recTemp("Name") = mstrCompany
recTemp("Address") = mstrAddress
recTemp("FEIN") = mstrFEIN
WriteItem = True
On Error GoTo 0
Exit Function
WriteItemError:
WriteItem = False
Exit Function
End Function
Property Get Number() As Integer
Number = mintNumber
End Property
Property Get Company() As String
Company = mstrCompany
End Property
Property Get Address() As String
Address = mstrAddress
End Property
Property Get FEIN() As String
FEIN = mstrFEIN
End Property
Option Explicit Const FLD_VENNUMBER = 1 Const FLD_INVNUMBER = 2 Const FLD_DATE = 3 Const FLD_AMOUNT = 4 Private mintVendorNumber As Integer Private mstrInvoiceNumber As String Private mdatDate As Date Private mcurAmount As Currency Private mstrDelimitedString As String
Property Let DelimitedString(strInput As String)
Dim strDelimiter As String
Dim intEnd As Integer, intField As Integer, intStart As _
Integer
Dim I As Integer
Dim strTextNumber As String
strDelimiter = Chr$(9): mstrDelimitedString = strInput
intStart = 1: intField = 1
Do
intEnd = InStr(intStart, strInput, strDelimiter)
If intEnd = 0 Then intEnd = Len(strInput) + 1
Select Case intField
Case 1
strTextNumber = ExtractField(intStart, intEnd)
If IsNumeric(strTextNumber) Then
If strTextNumber >= 1 And strTextNumber <= _
32767 Then
mintVendorNumber = Val(strTextNumber)
Else
mintVendorNumber = 0
End If
Else
mintVendorNumber = 0
End If
Case 2
mstrInvoiceNumber = ExtractField(intStart, intEnd)
Case 3
mdatDate = CDate(ExtractField(intStart, intEnd))
Case 4
mcurAmount = CCur(ExtractField(intStart, intEnd))
End Select
intStart = intEnd + 1: intField = intField + 1
Loop While intEnd < Len(strInput) And intField <= 4
End Property
Private Function WriteItem(recTemp As Recordset) As Boolean
On Error GoTo WriteItemError
recTemp("Vendor Number") = mintVendorNumber
recTemp("Invoice Number") = mstrInvoiceNumber
recTemp("Date") = mdatDate
recTemp("Amount") = mcurAmount
WriteItem = True
On Error GoTo 0
Exit Function
WriteItemError:
WriteItem = False
Exit Function
End Function
Public Function Retrieve(dbfTemp As Database, VendorNumber As _
Integer, _
InvoiceNumber As String) As Boolean
Dim recTemp As Recordset
On Error GoTo RetrieveError
Set recTemp = dbfTemp.OpenRecordset("Invoices", _
dbOpenTable, dbReadOnly)
recTemp.Index = "PrimaryKey"
recTemp.Seek "=", VendorNumber, InvoiceNumber
DBEngine.Idle dbFreeLocks
If Not recTemp.NoMatch Then
mintVendorNumber = VendorNumber
mstrInvoiceNumber = InvoiceNumber
mdatDate = recTemp("Date")
mcurAmount = recTemp("Amount")
Retrieve = True
Else
Retrieve = False
End If
On Error GoTo 0
Exit Function
RetrieveError:
Retrieve = False
Exit Function
End Function
Public Sub AddToGrid(grdTemp As MSFlexGrid, intGridRow As Integer)
With grdTemp
.Row = intGridRow
.Col = 1: .Text = mstrInvoiceNumber
.Col = 2: .Text = Format$(mdatDate, "Short Date")
.Col = 3: .Text = Format$(mcurAmount, "Currency")
End With
End Sub
Property Get VendorNumber() As Integer
VendorNumber = mintVendorNumber
End Property
Property Get InvoiceNumber() As String
InvoiceNumber = mstrInvoiceNumber
End Property
Property Get InvoiceDate() As Date
InvoiceDate = mdatDate
End Property
Property Get Amount() As Currency
Amount = mcurAmount
End Property
How It Works
The Form_Load event of frmMain initializes the grid and deletes any existing values from the database tables. (As noted in the discussion for step 5, you probably would not delete the records in a real production application.) When the user clicks the Import Data button, the data is imported from the text files into objects of the clsVendor and clsInvoice classes, and these objects are collected into Collection classes. The contents of each Collection class are then written to the database tables.
The cmdImport_Click routine controls the import process and does the portion of the work that does not require knowledge of the structure of the database tables or the format of the individual records within the imported text strings. The processing that does require such knowledge is encapsulated into the objects by providing methods within the objects to perform the needed operations.
Each line in the vendor and invoice input files represents one record. The cmdImport_Click routine reads a line, creates a new clsVendor or clsInvoice object, and passes the record to the object through the object's Property Let DelimitedString method. Property Let DelimitedString parses the text string into individual fields and assigns the field values to the object's property variables. Later, cmdImport_Click cycles through each of the collection objects and causes each object to store itself into the database by invoking the object's StoreNewItem method.
When the user clicks the List Vendors button, cmdListVendors_Click retrieves the vendor list from the Vendors table and displays it in the list box. When the user then clicks on a vendor name, the list box Click routine passes the vendor number of the selected vendor to frmMain's FillInvoiceList subroutine. FillInvoiceList creates a snapshot consisting of the invoice numbers of invoices for which the vendor numbers match the selected vendor. It then creates a clsInvoice object for each invoice, causes each object to retrieve itself from disk by invoking the object's Retrieve method, and adds the invoice object to a Collection object. When all the matching invoices have been retrieved, the list box Click subroutine cycles through the collection, causing each invoice object in the collection to display itself in a grid row.
Comments
A significant amount of code is duplicated, or duplicated with minor changes, between the two classes in this How-To. If Visual Basic were a full object-oriented programming language that supported class hierarchies with inheritance, this duplication would be unnecessary. The common code could be put into a parent object from which both clsVendor and clsInvoice would inherit. Each class would then add methods and override inherited methods as necessary to implement its unique needs.
Because Visual Basic doesn't have this feature, another approach would be to put the identical and nearly identical routines in code modules as Public procedures and let the class routines call them as needed. This option would certainly reduce code size, but it would also introduce two problems:
The bottom line: If encapsulation and simple code are more important to you than the smallest possible code size, use the technique described in this How-To. If minimizing the amount of code is more important, consider using Public procedures in code modules.
Problem
I have an application that tracks employee information for generating company ID cards, and I need to include a picture of the employee in the database. How can I do this from Visual Basic?
Technique
There are two basic techniques, each with its benefits and detriments, for saving graphical data in a Microsoft Access database. One method, the easier but more limiting of the two, is to use a PictureBox control as a data-bound control and link it to an OLE Object field in the Access database (the data type is represented by the constant dbLongBinary), allowing direct loading and saving of data to the database by use of the LoadPicture and SavePicture commands. This technique makes it simple to import pictures in common formats, such as the Windows bitmap (.BMP) format, the Graphic Interchange Format (.GIF), or the JPEG (.JPG) format, used by many graphics-processing software packages. However, the data is saved as raw binary information and is difficult to use outside of your application without allowing for an import/export feature in your Visual Basic code.
The second technique, which is more versatile, but much more complex, is to use an OLE Container control as a data-bound control, linking it to an OLE Object field in a manner similar to that used by the PictureBox control discussed in the first technique. The data, however, is stored as an OLE object, available for export by any application that can employ OLE Automation techniques for importing the data. This technique has its own problems. The data is linked to a specific OLE class; your user might not be able to work with the data from another application if he does not have that specific OLE class registered by the external application. Also, it assumes that the external application, in most instances, will be used to edit the object; this adds overhead to your application that might not be needed.
The first technique tends to be more commonly employed, but the second technique is used enough to make it worthwhile to provide further information on the subject. The Microsoft Knowledge Base, an excellent tool for programming research, provides several articles on the subject. Table 5.7 provides the names and article IDs of several relevant Knowledge Base entries.
| ARTICLE ID | NAME AND DESCRIPTION |
| Q147727 | "How To View Photos from the NWIND.MDB Database in VB 4.0." Although the article is for VB 4.0, its code is still up-to-date. The code provides a complete but complex method of loading the stored graphics in NWIND.MDB, a database provided with Visual Basic, into a PictureBox control with some API prestidigitation. Very educational. |
| Q103115 | "PRB: Invalid Picture Error When Trying To Bind Picture Control." If you have ever attempted to bind a PictureBox to an OLE Object database field and received this error, it's due to the fact that the control expects bitmap information, not an OLE object. The article explains in more detail. |
| Q153238 | "HOW TO: Use GetChunk and AppendChunk Methods of RDO Object." This article describes how to interact with Binary Large Objects (BLOBs) with certain RDO data sources, such as Microsoft SQL Server. |
Steps
Open and run PicLoad.VBP. You'll see a form appear, similar to the one displayed in Figure 5.7. Click the Load Picture button, and a File Open common dialog appears. Select a bitmap file, and click the Open button. That bitmap now displays in the center of the form, and it is added to the database. Move forward, then back, with the data control and the graphic reappears, loaded from the database.
Figure 5.7. The saving graphics form at startup.
Table 5.8. Objects and properties for the Picture Load form.
OBJECT PROPERTY SETTING Form Name Form1 Caption "Chapter 5.4 Example" Data Name dtaData Caption "Publishers" RecordSource "Publishers" Label Name lblPublishers Caption "Publisher: " Label Name lblPublisherName Caption "" BorderStyle 1 - Fixed Single DataSource dtaData DataField "Name" PictureBox Name picPicture DataSource dtaData DataField "Logo" CommandButton Name cmdLoad Caption "&Load Picture" CommandButton Name cmdClose Caption "&Close" Cancel True CommonDialog Name cdlPicture Filter "Bitmap files (*.bmp)|*.bmp|JPEG files (*.jpg, *.jpeg)|*.jpg;*.jpeg|GIF Files (*.gif)|*.gif|All Files (*.*)|*.*" DefaultExt "BMP" Flags &H1000
Option Explicit
Const BIBLIO_PATH = _
"C:\Program Files\Microsoft Visual Studio\VB6\Biblio.MDB"
Private Sub CheckForLogoField()
Dim dbfTemp As Database, tdfTemp As TableDef, fldTemp As Field
Dim blnLogoFieldExists As Boolean
On Error GoTo BadCheck
Set dbfTemp = Workspaces(0).OpenDatabase(BIBLIO_PATH)
For Each tdfTemp In dbfTemp.TableDefs
If tdfTemp.Name = "Publishers" Then
For Each fldTemp In tdfTemp.Fields
If fldTemp.Name = "Logo" Then
blnLogoFieldExists = True
Exit For
End If
Next
Exit For
End If
Next
If blnLogoFieldExists = False Then
If tdfTemp.Updatable Then
Set fldTemp = New Field
With fldTemp
.Name = "Logo"
.Type = dbLongBinary
End With
tdfTemp.Fields.Append fldTemp
Else
MsgBox "The database needs to be updated " & _
to Jet 3.0 format. " & _
"See How-To 5.7 for more information.", " & _
vbExclamation
End If
End If
On Error GoTo 0
Exit Sub
BadCheck:
MsgBox Err.Description, vbExclamation
End
End Sub
Private Sub Form_Load()
dtaData.DatabaseName = BIBLIO_PATH
CheckForLogoField
End Sub
Private Sub cmdLoad_Click()
On Error GoTo CancelLoad
cdlPicture.ShowOpen
On Error GoTo BadLoad
picPicture = LoadPicture(cdlPicture.filename)
On Error GoTo 0
On Error GoTo 0
Exit Sub
CancelLoad:
If Err.Number <> cdlCancel Then
MsgBox Err.Description, vbExclamation
Else
Exit Sub
End If
BadLoad:
MsgBox Err.Description, vbExclamation
Exit Sub
End Sub
Private Sub cmdClose_Click()
End
End Sub
How It Works
When Form1 loads, it sets up the dtaData data control, using the BIBLIO_PATH constant to set the DatabaseName property and point it at BIBLIO.MDB. Then, using the CheckForLogoField routine, it confirms that the [Logo] field exists in the [Publishers] table; if the [Logo] field does not exist, it adds the field. Because the PictureBox control is bound to the data control, all aspects of displaying the data from the [Logo] field are handled as any other bound control, including field updates. The cmdLoad button allows new data to be added to the field using the LoadPicture method. Because the new data is added to the bound control, the loaded picture is saved to the database and is automatically displayed when the record is again shown.
Comments
The method previously detailed is quick to implement and makes ensuring security easy. The data stored in the Logo field is stored as raw binary data; as such, it's not recognized as an OLE object and is not easily edited. This is also the primary drawback to this method, making it less portable (not easily used by other applications). This method does conserve space, because the OLE object requires other information stored with it to describe what it is, how it can be processed, and so on. But for sheer flexibility, the OLE object approach is superior, and the articles mentioned in Table 5.8 should be reviewed. Be warned, however, that the information covered in those articles is advanced and should be reviewed only when you are confident in your understanding of the technique demonstrated in this How-To.
Question
I have an operation that requires that several tables be updated. Because of the nature of the operation, I want all the tables to be updated--or, if an error occurs, none of the tables to be updated. How can I ensure that only complete operations are applied to my database?
Technique
In database parlance, a transaction is a single logical operation that can involve multiple physical operations. Take, for example, a simple transaction in a banking environment, one in which money is withdrawn from a checking account and deposited to a savings account. If the money is withdrawn from the checking account but not applied to the savings account, the depositor will be unhappy. If the money is deposited to the savings account but never withdrawn from the checking account, the bank will be equally unhappy.
Various things might go wrong to cause the update to either account to fail. There might be a power failure or an error in the program. In a multiuser environment, the table representing one of the accounts might be locked by another user. Because it is important that both accounts be updated--or that neither account be updated--there needs to be some way to ensure that if any part of the transaction fails, the entire transaction is abandoned.
To tell Visual Basic and the Jet database engine to enforce transaction integrity, you enclose (or "wrap") all the program code implementing the transaction between two statements. The statement BeginTrans tells the database engine, "The transaction starts here. From here on, don't actually update the database. Make sure that it's possible to perform every operation I specify, but instead of actually changing the database, write the changes to a memory buffer." The statement CommitTrans tells the engine, "There have been no errors since the last BeginTrans, and this is the end of the transaction. Go ahead and write the changes to the database." The process of "making the changes permanent" is known as committing the transaction.
You can cancel the transaction in one of two ways. One method is to close the Workspace object without executing the CommitTrans statement--that automatically cancels the transaction. Another way, the preferred way, is to execute a Rollback statement. Rollback simply tells the database engine, "Cancel the transaction." Upon calling Rollback, the database is set back to the untouched state it was in before the transaction occurred.
The normal way to use these statements is to turn on error trapping before executing the BeginTrans statement. Wrap the operations that implement the transaction between a BeginTrans...CommitTrans pair. If an error occurs, execute the Rollback statement as part of your error routine.
Here's an example. Assume that WithdrawFromChecking is a subroutine that withdraws funds from a checking account, and that DepositToSaving deposits funds to a savings account. Both take two arguments: the account number and the amount.
Sub CheckingToSaving(strAccountNumber as String, curAmount as Currency)
On Error Goto CheckingToSavingError
BeginTrans
WithdrawFromChecking strAccountNumber, curAmount
DepositToSaving strAccountNumber, curAmount
CommitTrans
Exit Sub
CheckingToSavingError:
Rollback
MsgBox Err.Description, vbExclamation
Exit Sub
End Sub
If an error occurs in either the WithdrawFromChecking or the DepositToSaving routine, the error trapping causes execution to branch to the CheckingToSavingError label. The code there executes the Rollback statement to terminate the transaction, displays an error message, and then exits from the subroutine. You can, of course, implement more sophisticated error handling, but the principle illustrated is the same--in the error routine, cancel the pending transaction with a Rollback.
Steps
Open and run the project TRANSACT.VBP. The form shown in Figure 5.8 appears. Enter the following record:
Author: Heyman, Bill [type this in as a new entry] Title: Visual Basic 6.0 Database How-To Publisher: Sams [select from the list] ISBN: 0-0000000-0-0 [not the actual ISBN!] Year Published: 1998
Click Save. The record is saved and the form is cleared, ready for another entry. Enter the same data again, this time choosing the author's name from the author list. Be sure to enter exactly the same ISBN. Click Save, and an error message should appear. The ISBN number is the primary key of the Titles table, and you cannot save two records with identical primary keys. Because this application uses the transaction protection features of the Jet engine and the error occurred within the transaction, no changes were made to the database.
Figure 5.8. The Transactor form on startup.
Table 5.9. Objects and properties for the Transactor form.
OBJECT PROPERTY SETTING Form Name Form1 Caption "Chapter 5.5 Example" ComboBox Name cboAuthor Sorted True ComboBox Name cboPublisher Sorted True TextBox Name txtYearPublished Text "" TextBox Name txtISBN Text "" TextBox Name txtTitle Text "" CommandButton Name cmdSave Caption "&Save" Default True CommandButton Name cmdClose Cancel True Caption "&Close" Label Name lblTransact Index 0 Caption "Author:" Label Name lblTransact Index 1 Caption "Title:" Label Name lblTransact Index 2 Caption "Publisher:" Label Name lblTransact Index 3 Caption "ISBN:" Label Name lblTransact Index 4 Caption "Year Published:"
Option Explicit Const BIBLIO_PATH = "C:\Program Files\Microsoft Visual Studio\VB6\Biblio.MDB" Const AUTHOR_LIST = 1 Const PUBLISHER_LIST = 2 Private blnFormIsDirty As Boolean Private blnRefillAuthorList As Boolean Private blnRefillPublisherList As Boolean
Private Sub Form_Load()
FillList AUTHOR_LIST: FillList PUBLISHER_LIST
blnFormIsDirty = False
End Sub
Sub FillList(intListType As Integer)
Dim cboTemp As ComboBox
Dim dbfTemp As Database, recTemp As Recordset
On Error GoTo FillListError
Set dbfTemp = DBEngine.Workspaces(0).OpenDatabase(BIBLIO_PATH)
Select Case intListType
Case AUTHOR_LIST
Set cboTemp = cboAuthor
Set recTemp = dbfTemp.OpenRecordset( _
"SELECT [Au_ID], " & _
"[Author] FROM [Authors]")
Case PUBLISHER_LIST
Set cboTemp = cboPublisher
Set recTemp = dbfTemp.OpenRecordset( _
"SELECT [PubID], " & _
"[Name] FROM [Publishers]")
End Select
cboTemp.Clear
If recTemp.RecordCount Then
recTemp.MoveFirst
Do
cboTemp.AddItem recTemp.Fields(1)
cboTemp.ItemData(cboTemp.NewIndex) = recTemp.Fields(0)
recTemp.MoveNext
Loop Until recTemp.EOF
End If
Exit Sub
FillListError:
Dim strErrMsg As String
strErrMsg = "Error while filling " & _
IIf(intListType = AUTHOR_LIST, "Author", "Publisher") & _
" list."
strErrMsg = strErrMsg & vbCr & Err.Number & " - " & _
Err.Description
MsgBox strErrMsg, vbCritical
End
End Sub
Function SaveRecord() As Boolean
Dim lngAuthorID As Long, lngPublisherID As Long
Dim dbfTemp As Database, recTemp As Recordset
On Error GoTo SaveError
Workspaces(0).BeginTrans
If cboAuthor.ListIndex = -1 Then
If cboAuthor.Text = "" Then Error 32767
1000 lngAuthorID = CreateAuthor(cboAuthor.Text)
blnRefillAuthorList = True
Else
lngAuthorID = cboAuthor.ItemData(cboAuthor.ListIndex)
End If
If cboPublisher.ListIndex = -1 Then
If cboPublisher.Text = "" Then Error 32766
1050 lngPublisherID = CreatePublisher(cboPublisher.Text)
blnRefillPublisherList = True
Else
lngPublisherID = _
cboPublisher.ItemData(cboPublisher.ListIndex)
End If
If txtTitle <> "" And txtISBN <> "" Then
Set dbfTemp = _
DBEngine.Workspaces(0).OpenDatabase(BIBLIO_PATH)
1100 Set recTemp = dbfTemp.OpenRecordset( _
"Titles", dbOpenTable)
With recTemp
.AddNew
![PubID] = lngPublisherID
![ISBN] = txtISBN
![Title] = txtTitle
![Year Published] = txtYearPublished
.Update
End With
1150 Set recTemp = dbfTemp.OpenRecordset( _
"Title Author", dbOpenTable)
With recTemp
.AddNew
![Au_ID] = lngAuthorID
![ISBN] = txtISBN
.Update
End With
Else
If txtTitle = "" Then Error 32765 Else Error 32764
End If
Workspaces(0).CommitTrans
On Error GoTo SaveErrorNoRollback
ClearForm
blnFormIsDirty = False
SaveRecord = True
On Error GoTo 0
Exit Function
SaveError:
Dim strErrMsg As String
Workspaces(0).Rollback
Select Case Err
Case 32767
strErrMsg = "You have not entered an author name"
Case 32766
strErrMsg = "You have not entered a publisher name"
Case 32765
strErrMsg = "You have not entered a title"
Case 32764
strErrMsg = "You have not entered an ISBN number"
Case Else
Select Case Erl
Case 1000
strErrMsg = "Error " & Err.Number & _
" (" & Err.Description & _
"} encountered creating new Authors " & _
"record."
Case 1050
strErrMsg = "Error " & Err.Number &
" (" & Err.Description & _
"} encountered creating new Publishers " _
"& record."
Case 1100
strErrMsg = "Error " & Err.Number & _
" (" & Err.Description & _
"} encountered creating new Titles " & _
"record."
Case 1150
strErrMsg = "Error " & Err.Number
& " (" & Err.Description & _
"} encountered creating new Title Author " _
"& record."
Case Else
strErrMsg = Err.Description
End Select
End Select
MsgBox strErrMsg, vbExclamation
SaveRecord = False
Exit Function
SaveErrorNoRollback:
MsgBox Err.Description, vbExclamation
Resume Next
End Function
Function CreateAuthor(strAuthorName As String) As Long
Dim dbfTemp As Database, recTemp As Recordset
Set dbfTemp = DBEngine.Workspaces(0).OpenDatabase(BIBLIO_PATH)
Set recTemp = dbfTemp.OpenRecordset("Authors", dbOpenTable)
With recTemp
.AddNew
![Author] = strAuthorName
.Update
.Bookmark = .LastModified
End With
CreateAuthor = recTemp![Au_ID]
End Function
Function CreatePublisher(strPublisherName As String) As Long
Dim dbfTemp As Database, recTemp As Recordset
Dim lngLastID As Long
Set dbfTemp = DBEngine.Workspaces(0).OpenDatabase(BIBLIO_PATH)
Set recTemp = dbfTemp.OpenRecordset("Publishers", dbOpenTable)
With recTemp
.Index = "PrimaryKey"
.MoveLast
lngLastID = ![PubID]
.AddNew
![PubID] = lngLastID + 1
![Name] = strPublisherName
.Update
End With
CreatePublisher = lngLastID + 1
End Function
Sub ClearForm()
If blnRefillAuthorList Then
FillList AUTHOR_LIST
blnRefillAuthorList = False
Else
cboAuthor.ListIndex = -1
End If
If blnRefillPublisherList Then
FillList PUBLISHER_LIST
blnRefillPublisherList = False
Else
cboPublisher.ListIndex = -1
End If
` Clear the text boxes.
txtTitle = ""
txtISBN = ""
txtYearPublished = ""
End Sub
Private Sub cmdClose_Click()
If blnFormIsDirty Then
Select Case MsgBox("Do you want to save the current " & _
record?", _
vbQuestion + vbYesNoCancel)
Case vbYes
If SaveRecord() = False Then Exit Sub
Case vbNo
End
Case vbCancel
Exit Sub
End Select
End If
End
End Sub
Private Sub txtISBN_Change()
blnFormIsDirty = True
End Sub
Private Sub txtTitle_Change()
blnFormIsDirty = True
End Sub
Private Sub txtYearPublished_Change()
blnFormIsDirty = True
End Sub
Private Sub cboAuthor_Change()
blnFormIsDirty = True
End Sub
Private Sub cboPublisher_Change()
blnFormIsDirty = True
End Sub
Private Sub cboAuthor_Click()
If cboAuthor.ListIndex <> -1 Then blnFormIsDirty = True
End Sub
Private Sub cboPublisher_Click()
If cboPublisher.ListIndex <> -1 Then blnFormIsDirty = True
End Sub
How It Works
When the user clicks Save, the cmdSave_Click event calls SaveRecord, which does most of the work. If the user has entered a new author or new publisher (instead of selecting an existing item from the author or publisher list), SaveRecord calls a function (CreateAuthor or CreatePublisher) to create the new record. It then saves the record. If an error occurs (either a Visual Basic error or a user-generated error), the error handler in SaveRecord rolls back the transaction.
Comment
The main use of transactions is to maintain integrity when you're updating more than one table as part of a single logical operation. You can also use BeginTrans, CommitTrans, and Rollback when you're performing multiple operations on a single table and you want to make sure that all the operations are performed as a unit.
Transactions can also speed up some database operations. Under normal conditions, every time you use the Update method, the Jet engine writes the changes to disk. Multiple small disk writes can significantly slow down an application. Executing a BeginTrans holds all the operations in memory until CommitTrans executes, which can noticeably improve execution time.
The transaction features described in this How-To work when you are using Microsoft Access database files and most of the other file types supported by the Jet engine. Some database types--Paradox is one example--do not support transactions. You can check whether the database supports transactions by reading the Transactions property of the database object:
Dim dbfTemp as Database Dim blnSupportsTransactions as Boolean ... blnSupportsTransactions = dbfTemp.Transactions ...
Using the transactions statements BeginTrans, CommitTrans, and Rollback with a database that does not support transactions does not generate an error--but you need to be aware that you won't get the transaction integrity protection these statements would normally provide.
Question
I know that Microsoft Access provides the capability to make a database smaller by compacting it. Microsoft Access also enables me to repair a database that has been corrupted. How can I perform these operations from my Visual Basic program?
Technique
When you delete data (or database objects) from a Microsoft Access database file, the Jet engine does not automatically shrink the size of the file to recover the no-longer-needed space. If the user deletes a significant amount of data, the file size can grow very large, and include a lot of wasted space. You can use the CompactDatabase method of the DBEngine object to recover this space.
Occasionally, a database file becomes corrupted by a General Protection Fault, a power failure, a bug in the database engine, or some other cause. Most corrupted databases can be restored by the RepairDatabase method of the DBEngine object.
Steps
Open the project REPAIR.VBP and run it. The form shown in Figure 5.9 appears. Choose Compact a database and click OK. The application asks you to designate an existing database and to supply a new filename for the compacted version of the database. When you have done so, the application compacts the database and displays a message indicating completion.
Figure 5.9. The Database Maintenance form on startup.
Choose Repair a database and click OK. The application asks you to designate a database to be repaired. When you have done so, the application repairs the database and displays a message indicating success.
Table 5.10. Objects and properties for the Database Maintenance form.
OBJECT PROPERTY SETTING Form Name Form1 Caption "Chapter 5.6 Example" Frame Name grpOperation Caption "Operation" OptionButton Name optCompact Caption "Compact a database" OptionButton Name optRepair Caption "Repair a database" CommandButton Name cmdOK Caption "OK" Default True CommandButton Name cmdClose Cancel True Caption "&Close"
2. Add the following code to the declarations section of Form1: Option Explicit
3. Enter the following code into Form1 as the Click event of cmdOK. The setting of optCompact determines whether the user wants to compact or repair the database. This procedure uses the Windows File Open common dialog box to get the name of the file to compact or repair. In the case of a compact operation, it then uses the File Save common dialog box to get the name of the output file. It then uses the DBEngine's CompactDatabase or RepairDatabase method to perform the operation.
Private Sub cmdOK_Click()
Dim strInput As String, strOutput As String
On Error GoTo OKError
With cdlDatabase
.DialogTitle = "Select File To " & _
IIf(optCompact, "Compact", "Repair")
.ShowOpen
End With
strInput = cdlDatabase.filename
If optCompact Then
With cdlDatabase
.DialogTitle = "Repaired Filename"
.filename = ""
.ShowSave
End With
strOutput = cdlDatabase.filename
Screen.MousePointer = vbHourglass
DBEngine.CompactDatabase strInput, strOutput
Screen.MousePointer = vbDefault
MsgBox "Database " & strInput & _
" compacted to " & strOutput
Else
Screen.MousePointer = vbHourglass
DBEngine.RepairDatabase strInput
Screen.MousePointer = vbDefault
MsgBox "Repair of " & strInput & " successful."
End If
On Error GoTo 0
Exit Sub
OKError:
Screen.MousePointer = vbDefault
If Err <> 32755 Then MsgBox Err.Description
Exit Sub
End Sub
Private Sub cmdClose_Click()
End
End Sub
How It Works
The cmdOK button supplies almost all the project's action. Depending on the selected option button, the cmdOK_Click event code first uses the CommonDialog control to retrieve the name of a valid Access database. After a name is returned, it issues either a CompactDatabase method or a RepairDatabase method, depending on the selected option button. If a CompactDatabase is required, the routine will again use the CommonDialog control to get the desired name for the compacted database. It has to do this because the CompactDatabase command cannot compact a database back into itself; instead, it rebuilds the database from the ground up, so to speak, into another Access database file. The RepairDatabase method, however, does not write to another database file and is instead called directly on the selected database.
Comments
It is strongly recommended that CompactDatabase be performed on Access databases regularly, because it reclaims wasted space and re-indexes tables to enable faster, more efficient use. RepairDatabase, on the other hand, should be used only when an Access database is indicated as corrupt. In Visual Basic, a trappable error is triggered when an Access database is corrupt, so automating this process is relatively easy. By setting up an On Error trap in your function and checking if Err is equal to 3049, you can make a call to the RepairDatabase method.
Question
I'd like to use stored QueryDef objects to reduce the execution time for my program. But I need to change one or two values each time I run my SELECT query. How can I use stored queries with replaceable parameters from Visual Basic?
Technique
Microsoft Access provides the parameter query as a variation of the standard SELECT query. The definition of a parameter query specifies one or more replaceable parameters--values to be supplied each time the query executes. Each replaceable parameter is represented by a name, which is used much like a field name. The name can be any legal object name, provided that the name has not already been used as a field name in any of the tables in the query.
For example, you have a query that extracts information about customer accounts from several tables. Each time the query runs, it requires a value for the [Customer Number] field in the Customers table. If the name of the replaceable parameter was CustNum, the WHERE clause of the query would be this:
WHERE Customers.[Customer Number] = [CustNum]
When run from Microsoft Access, a parameter query pops up an input box for the user at runtime. The user types a value, and this value is used as the replaceable parameter. When you use a stored parameter query from Visual Basic, your code must provide the value for the replaceable parameter before you execute the query.
You provide the replaceable value through the QueryDef object. Each QueryDef object owns a Parameters collection, which consists of a set of Parameter objects, each with a name. When you assign a value to a Parameter object, the QueryDef object uses that as the replaceable value when you run the query.
Following is the full syntax for assigning a value to a QueryDef Parameter object (where myQueryDef is an object variable assigned to a QueryDef object and CustNum is the name of a Parameter object):
qdfTempQueryDef.Parameters("CustNum") = 141516
This can be abbreviated using the bang operator like so:
qdfTempQueryDef![CustNum] = 141516
The sequence for using a stored parameter query from your Visual Basic code, therefore, is this:
Dim dbfTemp as Database Dim qdfTemp as QueryDef Dim recTemp as Recordset
Set dbfTemp = DBEngine.Workspaces(0).OpenDatabase("ACCOUNTS.MDB")
Set qdfTemp = dbfTemp.OpenQueryDef("Customer Data")
qdfTemp![CustNum] = 124151 qdfTemp![Start Date] = #1/1/97# ` the # signs delimit a date
Set recTemp = qdfTemp.OpenRecordset()
Steps
Open and run the project ParameterQuery.VBP. The form shown in Figure 5.10 appears. Select a publisher and then click OK. Then the form shown in Figure 5.11 appears with the first record in BIBLIO.MDB belonging to that publisher. If the publisher has no titles in the database, the form is blank. Browse through the records by using the browse buttons. To select a different publisher, click the Publisher button.
Figure 5.10. The project's Publisher Parameters form, showing publisher names.
Figure 5.11. The project's Publisher Titles form, showing publisher title information.
Table 5.11. Objects and properties for the Query User form.
OBJECT PROPERTY SETTING Form Name frmMain Caption "Publisher Information" Data Name dtaData Caption "Publisher's Titles By Author" TextBox Name txtPublisher DataSource dtaData DataField "Name" TextBox Name txtYearPublished DataSource dtaData DataField "Year Published" TextBox Name txtISBN DataSource dtaData DataField "ISBN" TextBox Name txtTitle DataSource dtaData DataField "Title" TextBox Name txtAuthor DataSource dtaData DataField "Author" Label Name lblQuery Index 0 Caption "Author:" Label Name lblQuery Index 1 Caption "Title:" Label Name lblQuery Index 2 Caption "ISBN:" Label Name lblQuery Index 3 Caption "Published:" Label Name lblQuery Index 4 Caption "by:" CommandButton Name cmdPublisher Caption "&Publisher" CommandButton Name cmdClose Cancel True Caption "&Close"
Table 5.12. Objects and properties for the Query User form.
OBJECT PROPERTY SETTING Form Name frmSelectPublisher Caption "Chapter 5.7 Example - Publishers" ListBox Name lstPublishers CommandButton Name cmdOK Caption "&OK" Default True CommandButton Name cmdCancel Cancel True Caption "&Cancel"
Option Explicit `NOTE: The constant does NOT include the database name this time. Const BIBLIO_PATH = "C:\Program Files\Microsoft Visual Studio\VB6" `Because the variable is public (exposed for use by other `objects), the naming conventions for variables do not apply `here - treat as a property. Public SelectedPubID As Integer
Private Sub Form_Load()
`Older versions of BIBLIO.MDB must be converted to the Jet 3.0
`format before a parameter query can be saved to it.
CheckDatabaseVersion
dtaData.DatabaseName = BIBLIO_PATH & "\Biblio.MDB"
cmdPublisher_Click
End Sub
Private Sub cmdPublisher_Click()
frmSelectPublisher.Show vbModal
If SelectedPubID > 0 Then
RunQuery
Else
frmMain.Caption = "Chapter 5.7 Example - No Titles"
End If
End Sub
Private Sub CheckDatabaseVersion()
Dim dbfTemp As Database, sngVersion As Single
Set dbfTemp = Workspaces(0).OpenDatabase(BIBLIO_PATH & _
"\Biblio.MDB")
`If the database's Version property is less than 3.0, then it
`needs to be converted before we can save a parameter query to
`it from 32-bit Visual Basic.
sngVersion = Val(dbfTemp.Version)
dbfTemp.Close: DBEngine.Idle dbFreeLocks
If Val(sngVersion) < 3 Then
`First, we'll back up the old database
FileCopy BIBLIO_PATH & "\Biblio.MDB", BIBLIO_PATH & _
"\BiblioBackup.MDB"
`Then, we'll use the CompactDatabase method to convert it
`to the version 3.0 format
CompactDatabase BIBLIO_PATH & "\Biblio.MDB", _
BIBLIO_PATH & "\BiblioNew.MDB", , dbVersion30
`Next, we'll delete the old database after we're sure the
`new one exists.
If Len(Dir("BiblioNew.MDB")) Then Kill BIBLIO_PATH & _
"\Biblio.MDB"
`Finally, we'll rename the new database to the old name,
`"Biblio.MDB".
If Len(Dir(BIBLIO_PATH)) = 0 Then
Name BIBLIO_PATH & "\BiblioNew.MDB" As BIBLIO_PATH & _
"\Biblio.MDB"
End If
End If
End Sub
Sub RunQuery()
Dim dbfTemp As Database, recTemp As Recordset
Dim qdfTemp As QueryDef
Dim strSQL As String
Dim blnFoundQuery As Boolean
On Error GoTo QueryError
Set dbfTemp = Workspaces(0).OpenDatabase(BIBLIO_PATH & _
"\Biblio.MDB")
For Each qdfTemp In dbfTemp.QueryDefs
If qdfTemp.Name = "Publisher's Titles By Author" Then
blnFoundQuery = True
Exit For
End If
Next
If blnFoundQuery = False Then
strSQL = "PARAMETERS pintPubID Long; " & _
"SELECT Authors.Author, Titles.Title, " & _
"Titles.ISBN, " & _
"Titles.[Year Published], Publishers.Name " & _
"FROM (Publishers INNER JOIN Titles ON "
strSQL = strSQL & "Publishers.PubID = " _
"Titles.PubID) " & _
"INNER JOIN " & _
"(Authors INNER JOIN [Title Author] ON " & _
"Authors.Au_ID = [Title Author].Au_ID) ON " & _
"Titles.ISBN = [Title Author].ISBN WHERE " & _
"Publishers.PubID " & _
"= pintPubID ORDER by Authors.Author;"
Set qdfTemp = dbfTemp.CreateQueryDef( _
"Publisher's Titles By " & _
"Author", strSQL)
Else
Set qdfTemp = dbfTemp.QueryDefs( _
"Publisher's Titles By Author")
End If
qdfTemp.Parameters![pintPubID] = SelectedPubID
Set dtaData.Recordset = qdfTemp.OpenRecordset()
If dtaData.Recordset.RecordCount > 0 Then
frmMain.Caption = "Chapter 5.7 Example - " & _
Str$(dtaData.Recordset.RecordCount) & _
IIf(dtaData.Recordset.RecordCount = 1, _
" Title", " Titles")
Else
frmMain.Caption = frmMain.Caption = "Chapter 5.7 _
Example - No Titles"
End If
On Error GoTo 0
Exit Sub
QueryError:
MsgBox Err.Description, vbExclamation
Exit Sub
End Sub
Private Sub cmdClose_Click()
End
End Sub
Option Explicit
Private Sub Form_Load()
Dim dbfTemp As Database, recTemp As Recordset
Dim strSQL As String
On Error GoTo LoadError
Set dbfTemp = Workspaces(0).OpenDatabase(BIBLIO_PATH)
strSQL = "SELECT [PubID], [Company Name] FROM " & _
"[Publishers]"
Set recTemp = dbfTemp.OpenRecordset(strSQL)
If recTemp.RecordCount Then
recTemp.MoveFirst
Do Until recTemp.EOF
If Not IsNull(recTemp![Company Name]) Then
lstPublishers.AddItem recTemp![Company Name]
Else
lstPublishers.AddItem ""
End If
lstPublishers.ItemData(lstPublishers.NewIndex) = _
recTemp![PubID]
recTemp.MoveNext
Loop
Else
MsgBox "There are no publishers in the database.", _
vbCritical
End
End If
On Error GoTo 0
Exit Sub
LoadError:
MsgBox Err.Description, vbCritical
End
End Sub
If lstPublishers.ListIndex > -1 Then
frmMain.SelectedPubID = _
lstPublishers.ItemData(lstPublishers.ListIndex)
Me.Hide
Else
MsgBox "You have not selected a publisher", vbExclamation
End If
End Sub
Private Sub lstPublishers_DblClick()
cmdOK_Click
End Sub
Private Sub cmdCancel_Click()
frmMain.SelectedPubID = 0
Hide
End Sub
How It Works
When frmMain loads, it immediately generates a Click event for cmdPublisher to display the Select Publisher form. When the user makes a selection from the publisher list and clicks OK, the PubID of the selected publisher is used to set the Public variable SelectedPubID. The value of SelectedPubID is then used as the parameter passed to the [Publisher's Titles by Author] query definition. After its parameter has been set, the QueryDef is used to create the recordset of title information.
Comments
The parameter query allows for the flexibility of dynamically built SQL statements, but with the optimized speed of static SQL. One of the other benefits to using a parameter query is the Requery method, which enables you to re-execute a parameter query with different values. Access will actually reuse the existing connection and be able to run the query faster. Also, the optimization engine built into Jet works best on static SQL (that is, SQL stored in the database, as opposed to the SQL statements stored in code), so you can get even more benefit from the use of a parameter query that is saved to a Microsoft Access database. For a similar example on the use of a parameter query, How-To 3.5 is another good reference, especially with the use of the Requery method.
© Copyright, Macmillan Computer Publishing. All rights reserved.