Jumat, 29 Oktober 2010

Create, Write, Open text file in VB6

'------------------------------------------------------------------'
 Append     : untuk menambah text di file text
 output     : untuk merubah seluruh isi file text
 input      : untuk membaca text di file text
 - If its to make a new file but empty then use
     Open App.Path & "\txtfile.txt" For Output As #1
     Close #1
 - But if its for deleting the file use
     Kill App.Path & "\txtfile.txt"
'------------------------------------------------------------------'


Private Sub cmdsave_Click()

Dim filelocation As String
On Error Resume Next
' loads save as box
    CommonDialog1.ShowSave
   
    filelocation = CommonDialog1.FileName
   
' append saves over file if it assists
    Open filelocation For Append As #1
        Print #1, Text1.Text
    Close #1
    Text1.Text = ""
     
   
End Sub

Private Sub cmdopen_Click()
Text1.Text = ""
Dim filelocation As String

' show open box
    CommonDialog1.ShowOpen
   
    filelocation = CommonDialog1.FileName

' input files into text1.text
    Open filelocation For Input As #1
   
Do Until EOF(1)

        Input #1, Data
        Text1.Text = Text1.Text + Data + vbNewLine
    EOF (1)
    Loop
    Close #1
   
End Sub

Private Sub Form_Load()
Text1.Text = ""
End Sub

Kamis, 28 Oktober 2010

condensed code format vb

Generic epson emulation matrix printer
               Chr(12)         = normal huruf
               Chr(14)         = memperlebar huruf
               Chr(15)         = set ON condensed printing
               Chr(18)         = set OFF condensed printing (normal)
               Chr(27) & "0"   = set ON 8 lines per vertical inch
               Chr(27) & "1"   = set ON 4 lines per vertical inch
               Chr(27) & "2"   = set ON 6 lines per vertical inch
               Chr(27) & "x1"  = set ON Letter quality
               Chr(27) & "x0"  = set OFF Letter quality
               print line per page = 58

Use VB To Print In DOS Mode; Dot Matrix Printing

Private Sub cmdPrint_Click()
'This is the sample how to print in Dos Mode and How to print it Bold!
'http://www.geocities.com/mdgnn/xcontrols.htm

    Open "Lpt1" For Output As #1
   
       Print #1, Chr(27) & "@" 'Initialize printer
       Print #1, Chr(27) & "A" & Chr(11)
       Print #1, Chr(27) & "E" 'Set Font Bold
       Print #1, "Printer is Bold"
       Print #1, "Printer is Bold"
       Print #1, Chr(27) & "F" ' Set Font Normal
      
       Print #1, "Printer is Normal"
       Print #1, "Printer is Normal"

   Close #1
End Sub

Controlling an Epson compatible printer directly with EscP2 codes

It seems that many people find it hard to configure DOS programs such as Sage, banking programs etc. to print in a sensible format to laser printers (or line / dot matrix ones for that matter).
The following codes can be used in DOS batch files or within an application's configuration program for controlling an Epson  or compatible EscP2 printer.  There are many different combinations for different printers but these are fairly standard ones:
 
Characters ASCII codes Effect
[ESC] @ 27 64 Reset printer
[ESC] x 1
27 120 49 'Near Letter Quality' On
[ESC] x 0
27 120 48 'Near Letter Quality' Off
[ESC] 4
27 52 Italics On
[ESC] 5
27 53 Italics Off
[ESC] G
27 71 Double Strike On
[ESC] H
27 72 Double Strike Off
[ESC] M
27 77 Elite (12 chars per inch) font size
[ESC] P
27 80 Pica (10 chars per inch) font size
[ESC] [SI]
[SI]
27 15
15
Condensed Print
[DC2]
18 Cancel Condensed Print
[ESC] [SO]
[SO]
27 14
14
Enlarged (one line)
[DC4]
[LF]
20
10
Cancel Enlarged
[ESC] W l
27 87 49 Enlarged (more than one line)
[ESC] W 0
27 87 48 Cancel Enlarged (more than one line)
[ESC] - 1
27 45 49 Underline On
[ESC] - 0
27 45 48 Underline Off
[ESC] E
27 69 Bold On
[ESC] F
27 70 Bold Off
[ESC] S 1
27 83 49 Subscript (e.g. x1)
[ESC] S 0
27 83 48 Superscript (e.g. x2)
[ESC] T
27 84 Cancel Super/Subscript
[ESC] R n
27 82 n Select different foreign character set
[ESC] % 0 n
27 37 n Select internation character set n
[ESC] ! n
27 33 n Change print mode
[ESC] 0 27 48 1/8" line spacing
[ESC] 1 27 49 7/9" line spacing
[ESC] 2 27 50 1/6" line spacing
[ESC] 3 n 27 51 n n/216" line spacing
[ESC] A n 27 65 n n/72" line spacing
[ESC] T n 27 84 n n/216" line feed
[ESC] C n 27 67 n Page length (n = no. of lines)
[ESC] C 0 n 27 67 48 n Page length (n = no. of inches)
[ESC] N n 27 78 n Perforation skip (n = no. of lines)
[ESC] 0 27 48 Cancel peforation skip
[ESC] D n n n n 27 68 Set tab stops to n n n n
[ESC] B n n n n 27 66 Set vertical tab stops to n n n n
[ESC] Q n 27 81 n Set right margin
[ESC] l n 27 108 n Set left margin
[BEL] 7 Sound bell
[BS]
8 Backspace
[HT] 9 Horizontal Tab
[LF] 10 Line Feed
[VT] 11 Vertical Tab
[FF] 12 Form Feed (new page)
[CR]
13 Carriage Return
[DC1] 17 Printer Enable
[DC3] 19 Printer Disable
[CAN] 24 Cancel last line
[DEL] 127 Delete last character
[ESC] < 27 60 Home Print head
[ESC] U 1 27 85 49 Undirectional printing on
[ESC] U 0 27 85 48 Undirectional printing off
[ESC] s 1 27 115 49 Half speed printing on
[ESC] s 1 27 114 48 Half speed printing off
[ESC] 8 27 56 Ignore paper empty
[ESC] 9 27 57 Cancel ignore paper empty
[ESC] K n1 n2 27 75 n1 n2 Single density graphics no. of data = n2 * 256 + n1
[ESC] L n1 n2 27 76 n1 n2 Double density graphics no. of data = n2 * 256 + n1
[ESC] Y n1 n2 27 89 n1 n2 Double speed, Double density graphics.
[ESC] Z n1 n2 27 90 n1 n2 Quad density graphics
[ESC] * m n1 n2 27 42 m n1 n2 8 dot graphics modes, m = mode
[ESC] ? n m 27 63 n m Change graphics mode n to work as m. n is K, L, Y, or Z
[ESC] & 0 n m a p1 ... p11 27 38 48 n m a p1 ... p11 Redefine character. p1..p11 = character data. a = attribute, n+m characters to change.
From a DOS batch file you can often send codes to a printer using ECHO commands which have been entered using EDIT.  This could be to a local printer or captured to a network printer, eg:
ECHO ~x1~M > LPT1:  to put the printer into NLQ elite pitch.
where ~ is the [ESC] character which in edit can be entered with Control P then Control [ and shows as an arrow pointing to the left.
Note in Windows 2000 and XP the & symbol is used to run two or more commands from the same command line therefore if an & symbol is required you need to add a ^ before it to pass the & symbol directly rather than Windows interpreting it. Another alternative is to add the codes to a text file using EDIT then sending the text file to the printer with a line such as:
COPY textfile.txt LPT1:
or COPY textfile.txt \\server\share
or TYPE textfile.txt > LPT1:
or PRINT textfile.txt
or NPRINT textfile.txt (for Novell systems)

From a simple DOS based BASIC such as Quick Basic 4.5 (QB45) you can send codes in a number of ways.  The easiest is to assign some codes to variables and use those in print # or lprint statements to the printer port.  You use the chr$() function to send unprintable codes such as Escape and Form Feed or those difficult to enter such as the double quote " which is chr$(34) i.e.:
esc$=CHR$(27)
boldon$=esc$+"E"
boldoff$=esc$+"F"formfeed$=chr$(12)

filenum=FREEFILE
OPEN "lpt1:" FOR OUTPUT AS filenum
   PRINT #filenum, boldon$ + "This is in bold" + boldoff$
CLOSE #filenum

LPRINT boldon$ + "This is in bold" + boldoff$
[ESC] is ascii 27, Control [.  Enter in EDIT using Control P, Control [.

Rabu, 27 Oktober 2010

Visual Basic & ADO Tutorial

Level:
Level2
This tutorial describes how you can use ADO objects in VB6. Now days, almost any time you write full fledged database application you will want to use ADO. Along with this, as your applications become more and more complex you will probably not want to rely on Visual Basic's data controls, but instead use the ADO objects directly. Read on to find out exactly how this can be done.
Originally Written By TheVBProgramer.
The "Alphabet Soup" of Database Access
 
Prior to VB6 and the introduction of ADO (ActiveX Data Objects), VB programmers would generally use DAO (Data Access Objects) to interact with local databases such as MS Access and use RDO (Remote Data Objects) to interact with client/server databases such as Oracle and SQL Server. The concept behind Visual Basic ADO was Universal Data Access (UDA), where one database access method could be used for any data source; it was designed to replace both DAO and RDO. DAO remains a viable technology for interacting with MS Access databases as it is faster than ADO for that purpose; however, ADO is more flexible – using ADO, one could develop a prototype database application using MS Access in the back-end, and with a "flick of the wrist" (i.e., with very little coding changes) "upsize" that same application to use Oracle or SQL Server. As far as RDO is concerned, no new versions of it have been developed beyond the version that shipped with Visual Basic, and there are no future plans for it.
 
In the VB4 and VB5 worlds, RDO was the main method used to interact with client/server databases. RDO works perfectly fine with VB6, so when folks migrated their VB5 applications over to VB6, little or no coding changes were required. However, ADO is the preferred method of database access for new VB6 applications .
 
About this Tutorial
 
This tutorial presents three small sample applications using ADO. All three applications use a local MS Access database.
The first sample application introduces the ADO Data Control (ADODC) which demonstrates a "quick and dirty" way to connect to a remote database. The second and third applications use ADO code: the second allows navigation and searching of a database table; the third allows navigation and updating on a database table. All three connect to an ODBC Data Source, which must be set up through the Windows Control Panel. How to do this is described below.
 
Note: If you have previously set up a DSN for the Biblio database as described in the previous topic on RDO, you can skip the section on setting up an ODBC data source and resume here.
 
Setting Up an ODBC Data Source
 
Follow the steps below to set up an ODBC Data Source (this process is also called "setting up a DSN", where "DSN" stands for "Data Source Name"). These steps assume Windows 2000 for the operating system. On other versions of Windows, some steps may vary slightly.
 
·         Via Windows Control Panel, double-click on Administrative Tools, then Data Sources (ODBC). The ODBC Data Source Administrator screen is displayed, as shown below. Click on the System DSN tab.
 
 
·         Click the Add button. The Create New Data Source dialog box will appear. Select Microsoft Access Driver (*.mdb) from the list and click the Finish button.
 
 
·         The ODBC Microsoft Access Setup dialog box will appear. For Data Source Name, type Biblio. If desired, you can type an entry for Description, but this is not required.
 
 
·         Click the Select button. The Select Database dialog box appears. On a default installation of VB6 or Visual Studio 6, the BIBLIO.MDB sample database should reside in the folder C:\Program Files\Microsoft Visual Studio\VB98. Navigate to that folder, select BIBLIO.MDB from the file list, and click OK.
 
 
Note: If VB was installed in a different location on your system, navigate to the appropriate folder. If you do not have the BIBLIO.MDB sample database file on your system at all, you can download it here. In that case, copy the file to the folder of your choice, and navigate to that folder to select the database for this step.
 
·         When you are returned to the ODBC Microsoft Access Setup screen, the database you selected should be reflected as shown below. Click OK to dismiss this screen.
 
 
·         When you are returned to the ODBC Data Source Administrator screen, the new DSN should appear as shown below. Click OK to dismiss this screen.
 
 
At this point, the Biblio database is ready to be used with RDO in the sample application.
 
Sample Application 1: Using the ADO Data Control (ADODC)
 
To build the first sample application, follow the steps below.
 
·         Start a new VB project, and from the Components dialog box (invoked from the Project -> Components menu), select Microsoft ADO Data Control 6.0 (SPx) as shown below and click OK.
 
The ADO Data Control should appear in your toolbox as shown below:
 
 
·         Put an ADO Data Control on your form, and set the properties as follows:
 
Property
Value
Name
adoBiblio
DataSourceName
Biblio
SQL
select * from authors
·         Now put three text boxes on the form, and set their Name, DataSource, and DataField properties as follows:
 
Name
DataSource
DataField
txtAuthor
adoBiblio
Author
txtAuID
adoBiblio
Au_ID
txtYearBorn
adoBiblio
Year Born
 
·         Save and run the program. Notice how it works just like the other data control.
 
·         Now change the SQL property of the data control to select * from authors order by author and run the program again. Notice the difference.
 
·         Change the SQL property back to what it was and add three command buttons to the form, and set their Name and Caption properties as follows:
 
Name
Caption
cmdNameOrder
Order by Name
cmdYearOrder
Order by Year
cmdIDOrder
Order by ID

 
·         Put the following code in the cmdNameOrder_Click event:
 
adoBiblio.SQL = "select * from authors order by author"
adoBiblio.Refresh
 
·         Put the following code in the cmdYearOrder_Click event:
 
adoBiblio.SQL = "select * from authors order by [year born]"
adoBiblio.Refresh
 
·         Put the following code in the cmdIDOrder_Click event:
 
adoBiblio.SQL = "select * from authors order by au_id"
adoBiblio.Refresh
 
·         Save and run the program and see what happens when you click the buttons.
 
A screen-shot of the sample app at run-time is shown below:
 
 
 
Download the project files for this sample application here.
 
 
Sample Applications 2 and 3: Using ADO Code
 
Note: If you have previously downloaded and set up a DSN for the Property database as described in the previous topic on RDO, you can skip the set up steps below and resume here.
 
Sample applications 2 and 3 use a database called PROPERTY.MDB and can be downloaded here.
 
The Property database contains just one table called "Property". The columns of this table are defined as follows:
 
Column Name
Data Type
Notes
PROPNO
Number (Long Integer)
A number that uniquely identifies the property in the table. Should be treated as the Primary Key (although it is not defined as such in the sample database).
EMPNO
Number (Long Integer)
A number that identifies the real estate agent selling the property. In a real system, this would be the foreign key to the employee number in an Employee table (such a table is not present in the sample database).
ADDRESS
Text (20)
The street address of the property.
CITY
Text (15)
The city where the property is located.
STATE
Text (2)
The state where the property is located (2-character US state abbreviation).
ZIP
Text (5)
The zip code where the property is located.
NEIGHBORHOOD
Text (15)
The descriptive name of the neighborhood in which the property is located.
HOME_AGE
Number (Long Integer)
Age in years of the home. (A better table design choice would be to have this field be the date in which the property was built and have the application compute the age based on the current date.)
BEDS
Number (Long Integer)
Number of bedrooms in the property.
BATHS
Number (Single)
Number of bathrooms in the property (allows for a decimal value such as 2.5, indicating 2 ½ bathrooms – i.e. 2 full bathrooms and 1 "powder room").
FOOTAGE
Number (Long Integer)
The footage of the property.
ASKING
Number (Long Integer)
Asking price of the property in whole dollars.
BID
Number (Long Integer)
Bid amount of the potential buyer in whole dollars.
SALEPRICE
Number (Long Integer)
Sale price (amount the property actually sold for) in whole dollars.
Before coding or running sample application 2 or 3, you must set up an ODBC data source as was done for the previous sample application.
 
After downloading the file, move it to the folder of your choice. Then follow the exact same steps as before to set up the DSN, with these two exceptions:
 
(1) On the ODBC Microsoft Access Setup dialog box, type PropDB for the Data Source Name.
 
(2) In the Select Database dialog box, navigate to the location where you have placed the PROPERTY.MDB file.
 
Sample Application 2
 
To build Sample Application 2, start a new VB project and perform the following steps.
 
·         From the Project -> References menu, check Microsoft ActiveX Data Objects 2.x (where x is the highest version that you have on your system) and click OK.
 
 
·         This project uses the StatusBar control, so include the Microsoft Windows Common Controls 6.0 (SP6) from the Components dialog box, accessed from the Project -> Components menu.
 
 
·         Create the form shown below. The names of the text boxes in the top frame are shown in the form. Set the Enabled property of the frame to False, which will automatically disable all of the textboxes within it, which is desired because this application does not allow updating of the data. The settings for the other controls are given below.
 
 
The navigation buttons have the following properties:
 
Name
Caption
cmdMoveFirst
<<
cmdMovePrevious
<
cmdMoveNext
>
cmdMoveLast
>>
 
 
The text box in the middle of the form has the following properties:
 
Name
txtCurrentQuery
MultiLine
True
Locked
True
 
The command buttons have the following properties:
 
Name
Caption
Enabled
cmdAllData
Reload All Records
True
cmdGetData
Run Query Now
False
 
In the "Select Criteria" frame:
 
The check boxes are an array:
Name
Caption
chkCriteria(0)
EmpNo
chkCriteria(1)
City
chkCriteria(2)
State
 
The labels are also an array:
Name
Caption
Enabled
lblCriteria(0)
=
False
lblCriteria(1)
Like
False
lblCriteria(2)
Like
False
 
The textboxes are also an array:
Name
Caption
Enabled
txtCriteria(0)
EmpNo
False
txtCriteria(1)
City
False
txtCriteria(2)
State
False
 
Place the StatusBar on the form and set its Style property to 1 – sbrSimple.
 
2. Code the General Declarations section as shown below. Here, two ADO objects, ADODB.Connection and ADODB.Recordset, are defined at the form level.
 
The ADODB.Connection object represents an open connection to a data source and a specific database on that data source, or an allocated but as yet unconnected object, which can be used to subsequently establish a connection.
 
The ADODB.Recordset object represents the rows that result from running a query,
 
Option Explicit
 
Dim mobjADOConn As ADODB.Connection
Dim mobjADORst As ADODB.Recordset
Dim mstrSQL As String
 
3. Code the Form_Load event. Here, the connection object variable mobjADOConn is made available for use by setting it to a new instance of ADODB.Connection. Then, the ConnectionString property and the Open method of the ADODB.Connection object are used.
 
The ConnectionString property takes a string with various arguments delimited by semicolons. When using a DSN as we are in this sample application, you typically need just the DSN name, the user id, and the password. The Open method then opens the connection to the database.
 
'-----------------------------------------------------------------------------
Private Sub Form_Load()
'-----------------------------------------------------------------------------
 
'set up the form and connect to the data source
On Error GoTo LocalError
'center the form:
Me.Top = (Screen.Height - Me.Height) / 2
Me.Left = (Screen.Width - Me.Width) / 2
' Connect to the Property database:
Set mobjADOConn = New ADODB.Connection
mobjADOConn.ConnectionString = "DSN=PropDB;Uid=admin;Pwd=;"
mobjADOConn.Open
Call cmdAllData_Click
 
Exit Sub
 
LocalError:
MsgBox Err.Number & " - " & Err.Description
End Sub
 
4. Code the cmdAllData_Click event, which sets or resets the ADODB.Recordset object with a query to display all the rows in the table. The opening of the recordset takes place in the OpenNewRecordset subprocedure, called from this event procedure.
 
'-----------------------------------------------------------------------------
Private Sub cmdAllData_Click()
'-----------------------------------------------------------------------------
 
On Error GoTo LocalError
Dim lngX As Long
 
'select or reload the data to be displayed:
mstrSQL = "select * from property"
Call OpenNewRecordset
'load data into the text boxes
Call DataLoad
 
' reset the state of the search criteria controls
For lngX = 0 To 2
chkCriteria(lngX).Value = vbUnchecked
Next
Exit Sub
LocalError:
MsgBox Err.Number & " - " & Err.Description
 
End Sub
 
5. Create the user-defined subprocedure OpenNewRecordset.
 
Here, the recordset object mobjADORst is made available for use by setting (or resetting) it to a new instance of ADODB.Recordset.
 
The CursorLocation property is then set to the built-in constant adUseClient. The term "cursor" refers to the temporary rows of a recordset. The cursor location determines whether the cursor is stored on the client or the server, specified by the values adUseClient and adUseServer, respectively. Server-side cursor (adUseServer) is the default. There are tradeoffs using both types of cursors. Client-side cursors can take a long time to build because the data must be pulled over to the client, but once built, traversing the cursor is usually very fast. Client-side cursors often support more features than server-side cursors (the reason this sample application is using a client-side cursor is because we want to use AbsolutePosition property later, which only works with a client-side cursor). On the other hand, server-side cursors usually build faster but often support fewer features that client-side cursors.
 
The Open method of the recordset is then executed. The Open method has the following syntax:
 
RecordsetObject.Open Source, ActiveConnection, CursorType, LockType, Options
 
The Source argument is an optional variant that evaluates to a valid Command object, SQL statement, table name, stored procedure call, or filename of a persisted recordset.
 
The ActiveConnection argument is an optional variant that evaluates to a valid Connection object variable name or a string containing connection string parameters.
 
The CursorType argument is an optional value that determines the type of cursor that the provider should use when opening the recordset. The possible values and their descriptions are given below:
 
Value
Description
adOpenForwardOnly
(default) Used to open a forward-only cursor. Forward-only cursors create static snapshots of data. A recordset that uses a forward-only cursor is not directly updateable and can only be scrolled from beginning to end (i.e., "MoveNext" is the only "Move" method that can be used with this type of cursor). Forward-only cursors offer optimal performance in exchange for feature limitations. Forward-only cursors are sometimes referred to as firehose cursors.
adOpenStatic
Used to open a static cursor. A static cursor is a static copy of the data in the data source. Once created, no changes made by other users propagate to the recordset; the recordset never changes. Note: Client side cursors (like the one used in this sample application) use only adOpenStatic for CursorTypes regardless of which CursorType you select.
adOpenDynamic
Used to open a dynamic cursor. A dynamic cursor is a "live" recordset, meaning that any and all additions, changes, and deletions by other users affect the recordset. Dynamic-cursor recordsets support all types of navigation, including bookmarks (if bookmarks are supported by the provider). Dynamic cursors offer the most features of any cursor type, but at the expense of increased overhead.
adOpenKeyset
Used to open a keyset cursor. Keyset cursors are like dynamic cursors, except additions made by other users are not visible in the recordset. The recordset is affected by changes and deletions, however.
The LockType argument is an optional value that determines the type of locking that the provider should use when opening the recordset. The possible values and their descriptions are given below:
 
Value
Description
adLockReadOnly
(default) Specifies read-only locking. Records can be read, but data cannot be added, changed, or deleted. This is the locking method used with static cursors and forward-only cursors.
adLockPessimistic
Specifies pessimistic locking. The provider does what is necessary to ensure successful editing of records, usually by locking records at the data source immediately upon editing.
adLockOptimistic
Specifies optimistic locking. The provider locks records only when you call the Update method, not when you start editing.
adLockBatchOptimistic
Specifies optimistic batch locking. Records are locked in batch update mode, as opposed to immediate update mode. This option is required for client-side cursors.
The Options argument is an optional Long value that indicates how the Source should be evaluated. The possible values and their descriptions are given below:
 
Value
Description
adCmdText
Indicates that the provider should evaluate CommandText as a textual definition of a command. This options is used SQL statements.
adCmdTable
Indicates that the provider should evaluate CommandText as a table.
adCmdStoredProc
Indicates that the provider should evaluate CommandText as a stored procedure.
adCmdUnknown
Indicates that the type of command in the CommandText argument is not known and that the provider should attempt to interpret it. Typically results in poor performance.
adExecuteAsync
Indicates that the command should execute asynchronously.
adFetchAsync
Indicates that the remaining rows after the initial quantity specified in the CacheSize property should be fetched asynchronously.
'-----------------------------------------------------------------------------
Private Sub OpenNewRecordset()
'-----------------------------------------------------------------------------
Set mobjADORst = New ADODB.Recordset
mobjADORst.CursorLocation = adUseClient
mobjADORst.Open mstrSQL, mobjADOConn, adOpenStatic, , adCmdText
 
' display current query
txtCurrentQuery.Text = mstrSQL
 
End Sub
 
 
6. Create the user-defined subprocedure DataLoad. This subprocedure gets the data from the recordset and puts each field into a text box. Data from the recordset is accessed via the Fields collection.
 
The Fields collection in ADO works identically to the Fields collection in DAO. A field can be referenced with or without specifying Fields, either by the field name in quotes or by its ordinal position in the resultset. The field can also be referenced with the bang (!) operator. All of the following would be valid ways of referencing the field "propno":
 
mobjADORst.Fields("propno")
mobjADORst ("propno")
mobjADORst.Fields(0)
mobjADORst(0)
mobjADORst!propno
 
'-----------------------------------------------------------------------------
Private Sub DataLoad()
'-----------------------------------------------------------------------------
On Error GoTo LocalError
 
'copy the data from the recordset to the text boxes:
txtPropNo.Text = mobjADORst.Fields("propno")
txtEmpNo.Text = mobjADORst.Fields("empno")
txtAddress.Text = mobjADORst.Fields("address")
txtCity.Text = mobjADORst.Fields("city")
txtState.Text = mobjADORst.Fields("state")
txtZip.Text = mobjADORst.Fields("zip")
Call SetRecNum
Exit Sub
LocalError:
MsgBox Err.Number & " - " & Err.Description
 
End Sub
 
7. Create the user-defined subprocedure SetRecNum. This sub displays the number of the current record at the bottom of the screen. The AbsolutePosition and RecordCount properties of the Recordset are used here.
 
The AbsolutePosition property specifies the current row in a recordset. Note: For AbsolutePosition to return a valid value with Access (Jet) databases (like the one used in the sample application), the CursorLocation must be set to adUseClient. An invalid value (-1) will be returned if adUseClient is specified.
 
The RecordCount property the total number of rows in the recordset. Note: RecordCount will not return a valid value with all cursor types (for example, RecordCount will return -1 with a forward-only cursor.) To ensure a valid RecordCount value, use either adOpenKeyset or adOpenStatic as the CursorType for server side cursors or use a client side cursor.
 
'-----------------------------------------------------------------------------
Private Sub SetRecNum()
'-----------------------------------------------------------------------------
StatusBar1.SimpleText = "row " & mobjADORst.AbsolutePosition _
& " of " & mobjADORst.RecordCount
End Sub
 
8. Code the events for the navigation buttons as shown below, using the recordset "Move" methods to move to the first, last, next, or previous record, respectively.

'-----------------------------------------------------------------------------
Private Sub cmdMoveFirst_Click()
'-----------------------------------------------------------------------------
On Error GoTo LocalError
 
mobjADORst.MoveFirst
Call DataLoad
Exit Sub
LocalError:
MsgBox Err.Number & " - " & Err.Description
End Sub
 
'-----------------------------------------------------------------------------
Private Sub cmdMoveLast_Click()
'-----------------------------------------------------------------------------
On Error GoTo LocalError
 
mobjADORst.MoveLast
Call DataLoad
Exit Sub
LocalError:
MsgBox Err.Number & " - " & Err.Description
End Sub
 
'-----------------------------------------------------------------------------
Private Sub cmdMoveNext_Click()
'-----------------------------------------------------------------------------
On Error GoTo LocalError
 
mobjADORst.MoveNext
If mobjADORst.EOF Then
Beep
mobjADORst.MoveLast
End If
Call DataLoad
Exit Sub
LocalError:
MsgBox Err.Number & " - " & Err.Description
End Sub
 
'-----------------------------------------------------------------------------
Private Sub cmdMovePrevious_Click()
'-----------------------------------------------------------------------------
On Error GoTo LocalError
 
mobjADORst.MovePrevious
If mobjADORst.BOF Then
Beep
mobjADORst.MoveFirst
End If
Call DataLoad
Exit Sub
LocalError:
MsgBox Err.Number & " - " & Err.Description
End Sub
 
9. When one of the check boxes is clicked, the label and text box next to it should be enabled (or disabled, if clicking the check box unchecks it). Note also that the cmdGetData button (the one with the "Run Query Now" caption) should only be enabled if one of the checkboxes is checked.
 
'-----------------------------------------------------------------------------
Private Sub chkCriteria_Click(Index As Integer)
'-----------------------------------------------------------------------------
 
' disable the 'Run Query Now' button
cmdGetData.Enabled = False
 
'when the user clicks on a check box, enable the label and text
'box that go with it.
If chkCriteria(Index).Value = vbChecked Then
txtCriteria(Index).Enabled = True
lblCriteria(Index).Enabled = True
txtCriteria(Index).SetFocus
txtCriteria(Index).SelStart = 0
txtCriteria(Index).SelLength = Len(txtCriteria(Index).Text)
' enable the 'Run Query Now' button only if a box is checked.
cmdGetData.Enabled = True
Else
txtCriteria(Index).Enabled = False
lblCriteria(Index).Enabled = False
End If
End Sub
 
10. After the user has selected which fields to use and entered values in the text boxes, they click the cmdGetData button to create a new recordset with new data. Note that if the user selects (checks) a field, but does not enter search criteria in the corresponding textbox, an error message is generated and the query is not run.
 
'-----------------------------------------------------------------------------
Private Sub cmdGetData_Click()
'-----------------------------------------------------------------------------
 
'run the query that the user has created
On Error GoTo LocalError
 
Dim blnFirstOne As Boolean
blnFirstOne = True
mstrSQL = "select * from property where "
If chkCriteria(0).Value = vbChecked Then
If (txtCriteria(0).Text = "") Or (Not IsNumeric(txtCriteria(0).Text)) Then
MsgBox "Employee number is missing or non-numeric. Query not run.", _
vbExclamation, _
"ADO Example"
Exit Sub
End If
blnFirstOne = False
mstrSQL = mstrSQL & "empno = " & txtCriteria(0).Text
End If
If chkCriteria(1).Value = vbChecked Then
If txtCriteria(1).Text = "" Then
MsgBox "City criteria is missing. Query not run.", _
vbExclamation, _
"ADO Example"
Exit Sub
End If
If blnFirstOne = False Then
mstrSQL = mstrSQL & " and"
End If
blnFirstOne = False
mstrSQL = mstrSQL & " city like '" & txtCriteria(1).Text & "'"
End If
If chkCriteria(2).Value = vbChecked Then
If txtCriteria(2).Text = "" Then
MsgBox "State criteria is missing. Query not run.", _
vbExclamation, _
"ADO Example"
Exit Sub
End If
If blnFirstOne = False Then
mstrSQL = mstrSQL & " and"
End If
blnFirstOne = False
mstrSQL = mstrSQL & " state like '" & txtCriteria(2).Text & "'"
End If
OpenNewRecordset
'make sure that the query did not return 0 rows:
If mobjADORst.EOF Then
MsgBox "Your query (" & mstrSQL & ") returned no records! " _
& "The default query to return all records will now be rerun.", _
vbExclamation, _
"ADO Example"
'reload the form with all the records
cmdAllData_Click
Else
MsgBox "Your query returned " & mobjADORst.RecordCount & " records.", _
vbInformation, _
"ADO Example"
'load data into the text boxes
Call DataLoad
End If
Exit Sub
LocalError:
MsgBox Err.Number & " - " & Err.Description
 
End Sub
 
11. Save and run. Note: When entering the "Like" criteria for City and/or State, you can use the wildcard character % to represent any number of characters and the wildcard character _ (underscore) the represent a single character. For example, entering "M%" for the City criteria would return all rows where the city field begins with the letter "M".
 
Download the project files for this sample application here.
 
Sample Application 3
 
Sample Application 3 demonstrates how to add, update, and delete records with ADO.
 
When the application is first run, the user is prompted to enter a minimum asking price to possibly limit the number of records they want to work with (i.e., "I only want to work with properties that are selling for $200,000 or more). If the user wants to work with all properties, they would simply accept the default of 0 from the prompt. If the user clicks the Cancel button, the application will end.
 
 
Once the user has entered the minimum asking price, the main screen of the application is displayed. Initially, the screen is in "browse" mode, where the user can use the navigation buttons to move to the first, previous, next or last record. The data cannot be edited in this mode. If they want to initiate an add or an update, delete a record, or exit the application, they may do so via the appropriate button. Saving or cancelling is not applicable in this mode, so those buttons are disabled.
 
 
If the user clicks the Add button, the fields on the screen are enabled and cleared, and the user can enter the information for the new property. All buttons except Save and Cancel are now disabled. After the user has made entries in the fields, he or she would click Save to add the new record to the database table, or, if they changed their mind, would click Cancel to discard the new record. In either case (clicking Save or Cancel) the user is returned to browse mode. When Save is clicked, the application validates the entries and will only save the record if all fields pass edit (otherwise, a message will appear indicating the problem entry and focus will be set to the problem field).
 
 
If the user clicks the Update button, the fields on the screen are enabled and the user can modify any or all of the fields (except for the Property Number, which is the primary key of the table). All buttons except Save and Cancel are now disabled. After the user has made modifications in the desired fields, he or she would click Save to update the record to the database table, or, if they changed their mind, would click Cancel to discard the changes. In either case (clicking Save or Cancel) the user is returned to browse mode. When Save is clicked, the application validates the entries and will only save the record if all fields pass edit (otherwise, a message will appear indicating the problem entry and focus will be set to the problem field).
 
 
If the user clicks the Delete button, the user is asked to confirm that they want to delete the current record. If they respond Yes, the record is deleted from the database table, and the main screen shows the next record in the table.
 
 
 
To build Sample Application 3, start a new VB project and perform the following steps.
 
·         From the Project -> References menu, check Microsoft ActiveX Data Objects 2.x Library and click OK.
 
 
·         This project uses the StatusBar control, so include the Microsoft Windows Common Controls 6.0 (SP6) from the Components dialog box, accessed from the Project -> Components menu. Check this item and click OK.
 
 
 
·         Create the form shown below. The settings for the various controls are given below.
 
 
·         There are nine textboxes in the main frame of the form. The names and MaxLength settings for these are given below:
 
Name
Properties
txtPropNo
MaxLength: 5
txtEmpNo
MaxLength: 4
txtAddress
MaxLength: 20
txtCity
MaxLength: 15
txtState
MaxLength: 2
txtZip
MaxLength: 5
txtBeds
MaxLength: 1
txtBaths
MaxLength: 3 (allows fractional amount, like 1.5)
txtAsking
MaxLength: 0 (not specified)
 
·         Set up the Command Buttons as follows:
 
Name
Caption
cmdMoveFirst
<<
cmdMovePrevious
<
cmdMoveNext
>
cmdMoveLast
>>
cmdAdd
Add
cmdUpdate
Update
cmdDelete
Delete
cmdSave
Save
cmdCancel
Cancel
cmdExit
Exit
 
·         All controls on your form should have their TabIndex property set such that the tabbing order is correct.
 
·         Add a Module to the project, name it modCommon, and enter the code shown below. The code contains procedures described as follows:
 
CenterForm
Sub to center a form on the screen
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.
UnFormatNumber
Function to strip out non-numeric characters (dollar signs, commas, etc.) from a formatted number.
 
Option Explicit
 
Public Const gstrNUMERIC_DIGITS As String = "0123456789"
Public Const gstrUPPER_ALPHA_PLUS As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ,'-"
 
Public gblnPopulating As Boolean
 
'------------------------------------------------------------------------
Public Sub CenterForm(pobjForm As Form)
'------------------------------------------------------------------------
 
With pobjForm
.Top = (Screen.Height - .Height) / 2
.Left = (Screen.Width - .Width) / 2
End With
 
End Sub
 
'------------------------------------------------------------------------
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 gblnPopulating Then Exit Sub
If pobjTextBox2.Enabled = False Then Exit Sub
If Len(pobjTextBox1.Text) = pobjTextBox1.MaxLength Then
pobjTextBox2.SetFocus
End If
 
End Sub
 
'-----------------------------------------------------------------------------
Public Function UnFormatNumber(pstrNumberIn As String) As String
'-----------------------------------------------------------------------------
 
Dim lngX As Long
Dim strCurrChar As String
Dim strNumberOut As String
strNumberOut = ""
For lngX = 1 To Len(pstrNumberIn)
strCurrChar = Mid$(pstrNumberIn, lngX, 1)
If InStr("0123456789.", strCurrChar) > 0 Then
strNumberOut = strNumberOut & strCurrChar
End If
Next
UnFormatNumber = strNumberOut
 
End Function
 
·         Code the General Declarations section as shown below. Here, as in the previous sample application, two ADO object variables, mobjADOConn and mobjADORst, are defined at the form level, as are some other form-level variables that will be needed.
 
Option Explicit
 
Dim mobjADOConn As ADODB.Connection
Dim mobjADORst As ADODB.Recordset
Private mstrSQL As String
Private mdblMinAsking As Double
Private mblnUpdatePending As Boolean
Private mstrUpdateType As String
 
Private mavntUSStates As Variant
 
·         Code the Form_Load event as shown below. In it, a programmer-defined Sub named GetMinimumAsking is called (that routine is the one that displays the initial prompt to the user to enter the minimum asking price of the properties they want to work with). Then, the variant array mavntUSStates is loaded with the 50 US state abbreviations, needed for validating the state input by the user. This is followed by a call to the CenterForm sub. Then, the ADO connection object (mobjADOConn) is instantiated, its ConnectionString property is set, and the Open method is invoked so that we can use the Property database in the application. This is followed by a call to the programmer-defined Sub GetPropertyData (which runs the query to create the recordset that will be used to browse the Property table records), followed by a call to the programmer-defined Sub SetFormState (which enables and disables controls at the appropriate time).
 
'-----------------------------------------------------------------------------
Private Sub Form_Load()
'-----------------------------------------------------------------------------
On Error GoTo LocalError
' obtain the minimum asking price for the properties to be worked with
GetMinimumAsking
' load the array of states to be used for validation
mavntUSStates = Array("AK", "AL", "AR", "AZ", "CA", "CO", "CT", "DC", _
"DE", "FL", "GA", "HI", "IA", "ID", "IL", "IN", _
"KS", "KY", "LA", "MA", "MD", "ME", "MI", "MN", _
"MO", "MS", "MT", "NC", "ND", "NE", "NH", "NJ", _
"NM", "NV", "NY", "OH", "OK", "OR", "PA", "RI", _
"SC", "SD", "TN", "TX", "UT", "VA", "VT", "WA", _
"WI", "WV", "WY")
'center the form:
CenterForm Me
' Connect to the Property database:
Set mobjADOConn = New ADODB.Connection
mobjADOConn.ConnectionString = "DSN=PropDB;Uid=admin;Pwd=;"
mobjADOConn.Open
 
Call GetPropertyData
 
SetFormState False
 
Exit Sub
 
LocalError:
MsgBox Err.Number & " - " & Err.Description
End Sub
 
Code the GetMinimumAsking Sub, which uses the InputBox function to prompt to the user to enter the minimum asking price of the properties they want to work with. The resulting value is then stored in the form-level variable mdblMinAsking.
 
'-----------------------------------------------------------------------------
Private Sub GetMinimumAsking()
'-----------------------------------------------------------------------------
Dim strInputBoxPrompt As String
Dim strAsking As String
 
strInputBoxPrompt = "Enter the minimum asking price (for example, 200000) " _
& "for the properties that you want to work with this session." _
& vbNewLine _
& "To work with ALL properties, leave the default of zero."
strAsking = InputBox(strInputBoxPrompt, "Minimum Asking Price", "0")
If strAsking = "" Then
' user clicked Cancel button on the input box, so end the app
End
End If
mdblMinAsking = Val(strAsking)
 
End Sub
 
Code the GetPropertyData Sub, which builds the SQL to get the property records meeting the minimum asking price condition. The Recordset object is then instantiated, its CursorLocation property is set, and its Open method is invoked to execute the SQL and return the resultset. This is done in a loop in case the resultset does not return any records due to the fact no records in the table met the asking price condition. In that situation, the user is given the opportunity to specify a different asking price value. Following this, the programmer-defined Sub PopulateFormFields is called (which displays the fields from the current record in their corresponding textboxes on the form).
 
'-----------------------------------------------------------------------------
Private Sub GetPropertyData()
'-----------------------------------------------------------------------------
 
On Error GoTo LocalError
Dim blnGotData As Boolean
blnGotData = False
Do
'select or reload the data to be displayed:
mstrSQL = "select propno" _
& " , empno" _
& " , address" _
& " , city" _
& " , state" _
& " , zip" _
& " , beds" _
& " , baths" _
& " , asking" _
& " from property" _
& " where asking >= " & mdblMinAsking _
& " order by propno"
Set mobjADORst = New ADODB.Recordset
mobjADORst.CursorLocation = adUseClient
mobjADORst.Open mstrSQL, mobjADOConn, adOpenDynamic, adLockOptimistic, adCmdText
If mobjADORst.EOF Then
If MsgBox("There are no properties with an asking price >= " _
& Format$(mdblMinAsking, "Currency") _
& ". Do you want to try again with a different value?", _
vbYesNo + vbQuestion, _
"Asking Price") _
= vbYes Then
GetMinimumAsking
Else
End
End If
Else
blnGotData = True
End If
Loop Until blnGotData
'load data into the text boxes
Call PopulateFormFields
Exit Sub
LocalError:
MsgBox Err.Number & " - " & Err.Description
 
End Sub
 
Code the PopulateFormFields Sub, which assigns the fields from the current record to their corresponding textboxes on the form. Note that the gblnPopulating Boolean variable is set to True prior to the assignments and set to False after the assignments. This value is used to control whether or not certain code executes in the event procedures for some of these textboxes. The Sub SetRecNum is then called.
 
'-----------------------------------------------------------------------------
Private Sub PopulateFormFields()
'-----------------------------------------------------------------------------
On Error GoTo LocalError
 
gblnPopulating = True
 
'copy the data from the resultset to the text boxes:
txtPropNo.Text = mobjADORst.Fields("propno")
txtEmpNo.Text = mobjADORst.Fields("empno")
txtAddress.Text = mobjADORst.Fields("address")
txtCity.Text = mobjADORst.Fields("city")
txtState.Text = mobjADORst.Fields("state")
txtZip.Text = mobjADORst.Fields("zip")
txtBeds.Text = mobjADORst.Fields("beds")
txtBaths.Text = mobjADORst.Fields("baths")
txtAsking.Text = Format$(mobjADORst.Fields("asking"), "Currency")
gblnPopulating = False
 
Call SetRecNum
Exit Sub
LocalError:
MsgBox Err.Number & " - " & Err.Description
 
End Sub
 
Code the SetRecNum Sub. This sub is identical to the one used in Sample Application 2. It displays the number of the current record at the bottom of the screen using the AbsolutePosition and RowCount properties of the Recordset object.
 
'-----------------------------------------------------------------------------
Private Sub SetRecNum()
'-----------------------------------------------------------------------------
StatusBar1.SimpleText = "row " & mobjADORst.AbsolutePosition _
& " of " & mobjADORst.RecordCount
End Sub
 
Code the SetFormState Sub, which takes in a Boolean argument used to set the Enabled property of the controls on the form. Based on whether the value True or False is passed to this sub, this sub ensures that the textboxes are enabled for adds and updates and disabled for browsing; it also ensures that the various command buttons are enabled or disabled at the appropriate time. This Sub also sets the form-level Boolean variable mblnUpdatePending.
 
'-----------------------------------------------------------------------------
Private Sub SetFormState(pblnEnabled As Boolean)
'-----------------------------------------------------------------------------
 
txtPropNo.Enabled = pblnEnabled
txtEmpNo.Enabled = pblnEnabled
txtAddress.Enabled = pblnEnabled
txtCity.Enabled = pblnEnabled
txtState.Enabled = pblnEnabled
txtZip.Enabled = pblnEnabled
txtBeds.Enabled = pblnEnabled
txtBaths.Enabled = pblnEnabled
txtAsking.Enabled = pblnEnabled
 
cmdSave.Enabled = pblnEnabled
cmdCancel.Enabled = pblnEnabled
cmdAdd.Enabled = Not pblnEnabled
cmdUpdate.Enabled = Not pblnEnabled
cmdDelete.Enabled = Not pblnEnabled
cmdExit.Enabled = Not pblnEnabled
cmdMoveFirst.Enabled = Not pblnEnabled
cmdMoveNext.Enabled = Not pblnEnabled
cmdMovePrevious.Enabled = Not pblnEnabled
cmdMoveLast.Enabled = Not pblnEnabled
mblnUpdatePending = pblnEnabled
 
End Sub
 
Code the Form_Unload event. In it, the form-level Boolean variable mblnUpdatePending is tested to see if (well, an update is pending – i.e., whether an add or update is in progress). If the user is in the middle of an add or update and then clicks the "X" button on the upper-right corner of the form, they will receive the message that they must save or cancel prior to exiting the application, and the form will NOT be unloaded (because we are assigning a non-zero value to the Cancel argument in that situation). Provided that an add or update is not in progress, we set the database objects to Nothing and the Unload will complete.
 
'-----------------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
'-----------------------------------------------------------------------------
 
If mblnUpdatePending Then
MsgBox "You must save or cancel the current operation prior to exiting.", _
vbExclamation, _
"Exit"
Cancel = 1
Else
Set mobjADORst = Nothing
Set mobjADOConn = Nothing
End If
End Sub
 
Code the events for the various Textboxes as shown below. The code in these events ensure the following:
·         For all, highlight the text in the textbox when it receives focus.
·         For all but the last textbox, if the maximum number of characters typed into the textbox is reached, auto-tab to the next textbox.
·         Only numeric digits should be entered into the property number, employee number, zip codes, and beds textboxes.
·         Only numeric digits and optionally one decimal point should be entered into the baths and asking textboxes.
·         Force uppercase on the state textbox.
·         When the asking textbox receives focus, the value in there should be unformatted. When the asking textbox loses focus, its value should be formatted as currency.
 
'-----------------------------------------------------------------------------
' Textbox events
'-----------------------------------------------------------------------------
 
' property #
Private Sub txtPropNo_GotFocus()
SelectTextBoxText txtPropNo
End Sub
Private Sub txtPropNo_KeyPress(KeyAscii As Integer)
KeyAscii = ValidKey(KeyAscii, gstrNUMERIC_DIGITS)
End Sub
Private Sub txtPropNo_Change()
TabToNextTextBox txtPropNo, txtEmpNo
End Sub
 
' emp #
Private Sub txtEmpNo_GotFocus()
SelectTextBoxText txtEmpNo
End Sub
Private Sub txtEmpNo_KeyPress(KeyAscii As Integer)
KeyAscii = ValidKey(KeyAscii, gstrNUMERIC_DIGITS)
End Sub
Private Sub txtEmpNo_Change()
TabToNextTextBox txtEmpNo, txtAddress
End Sub
 
' address
Private Sub txtAddress_GotFocus()
SelectTextBoxText txtAddress
End Sub
Private Sub txtAddress_Change()
TabToNextTextBox txtAddress, txtCity
End Sub
 
' city
Private Sub txtCity_GotFocus()
SelectTextBoxText txtCity
End Sub
Private Sub txtCity_Change()
TabToNextTextBox txtCity, txtState
End Sub
 
' state
Private Sub txtState_GotFocus()
SelectTextBoxText txtState
End Sub
Private Sub txtState_KeyPress(KeyAscii As Integer)
KeyAscii = ConvertUpper(KeyAscii)
End Sub
Private Sub txtState_Change()
TabToNextTextBox txtState, txtZip
End Sub
 
' zip
Private Sub txtZip_GotFocus()
SelectTextBoxText txtZip
End Sub
Private Sub txtZip_KeyPress(KeyAscii As Integer)
KeyAscii = ValidKey(KeyAscii, gstrNUMERIC_DIGITS)
End Sub
Private Sub txtZip_Change()
TabToNextTextBox txtZip, txtBeds
End Sub
 
' beds
Private Sub txtBeds_GotFocus()
SelectTextBoxText txtBeds
End Sub
Private Sub txtBeds_KeyPress(KeyAscii As Integer)
KeyAscii = ValidKey(KeyAscii, gstrNUMERIC_DIGITS)
End Sub
Private Sub txtBeds_Change()
TabToNextTextBox txtBeds, txtBaths
End Sub
 
' baths
Private Sub txtBaths_GotFocus()
SelectTextBoxText txtBaths
End Sub
Private Sub txtBaths_KeyPress(KeyAscii As Integer)
KeyAscii = ValidKey(KeyAscii, gstrNUMERIC_DIGITS & ".")
' if text already has a decimal point, do not allow another ...
If Chr$(KeyAscii) = "." And InStr(txtBaths.Text, ".") > 0 Then
KeyAscii = 0
End If
End Sub
Private Sub txtBaths_Change()
TabToNextTextBox txtBaths, txtAsking
End Sub
 
' asking price
Private Sub txtAsking_GotFocus()
txtAsking.Text = UnFormatNumber(txtAsking.Text)
SelectTextBoxText txtAsking
End Sub
Private Sub txtAsking_KeyPress(KeyAscii As Integer)
KeyAscii = ValidKey(KeyAscii, gstrNUMERIC_DIGITS & ".")
' if text already has a decimal point, do not allow another ...
If Chr$(KeyAscii) = "." And InStr(txtAsking.Text, ".") > 0 Then
KeyAscii = 0
End If
End Sub
Private Sub txtAsking_LostFocus()
txtAsking.Text = Format$(txtAsking.Text, "Currency")
End Sub
 
Code the events for the navigation buttons as shown below, using the resultset "Move" methods to move to the first, last, next, or previous record, respectively.

'-----------------------------------------------------------------------------
Private Sub cmdMoveFirst_Click()
'-----------------------------------------------------------------------------
On Error GoTo LocalError
 
mobjADORst.MoveFirst
Call PopulateFormFields
Exit Sub
LocalError:
MsgBox Err.Number & " - " & Err.Description
End Sub
 
'-----------------------------------------------------------------------------
Private Sub cmdMoveLast_Click()
'-----------------------------------------------------------------------------
On Error GoTo LocalError
 
mobjADORst.MoveLast
Call PopulateFormFields
Exit Sub
LocalError:
MsgBox Err.Number & " - " & Err.Description
End Sub
 
'-----------------------------------------------------------------------------
Private Sub cmdMoveNext_Click()
'-----------------------------------------------------------------------------
On Error GoTo LocalError
 
mobjADORst.MoveNext
If mobjADORst.EOF Then
Beep
mobjADORst.MoveLast
End If
Call PopulateFormFields
Exit Sub
LocalError:
MsgBox Err.Number & " - " & Err.Description
End Sub
 
'-----------------------------------------------------------------------------
Private Sub cmdMovePrevious_Click()
'-----------------------------------------------------------------------------
On Error GoTo LocalError
 
mobjADORst.MovePrevious
If mobjADORst.BOF Then
Beep
mobjADORst.MoveFirst
End If
Call PopulateFormFields
Exit Sub
LocalError:
MsgBox Err.Number & " - " & Err.Description
End Sub
 
Code the Click event for the cmdAdd button. In it, the textboxes are cleared, the SetFormState sub is called (passing it a parameter of True, which will enable the textboxes and the Save and Cancel buttons and disable all the other buttons), set the form-level variable mstrUpdateType to "A" (indicating that an add is pending) and sets focus to the Property Number field.
'-----------------------------------------------------------------------------
Private Sub cmdAdd_Click()
'-----------------------------------------------------------------------------
 
On Error GoTo LocalError
 
'clear all the text boxes:
txtPropNo.Text = ""
txtEmpNo.Text = ""
txtAddress.Text = ""
txtCity.Text = ""
txtState.Text = ""
txtZip.Text = ""
txtBeds.Text = ""
txtBaths.Text = ""
txtAsking.Text = ""
SetFormState True
mstrUpdateType = "A"
txtPropNo.SetFocus
Exit Sub
LocalError:
MsgBox Err.Number & " - " & Err.Description
End Sub
 
Code the Click event for the cmdUpdate button. In it, the SetFormState sub is called (passing it a parameter of True, which will enable the textboxes and the Save and Cancel buttons and disable all the other buttons), set the form-level variable mstrUpdateType to "U" (indicating that an update is pending), disables the Property Number field (because it is the primary key and should not be changed) and sets focus to the Employee Number field.
 
'-----------------------------------------------------------------------------
Private Sub cmdUpdate_Click()
'-----------------------------------------------------------------------------
 
On Error GoTo LocalError
 
SetFormState True
mstrUpdateType = "U"
' being that propno is the primary key, it should not be updatable
txtPropNo.Enabled = False
txtEmpNo.SetFocus
Exit Sub
LocalError:
MsgBox Err.Number & " - " & Err.Description
End Sub
 
Code the Click event for the cmdSave button. The user would click this button after they have completed entries for an add or update. This sub first invokes the ValidateAllFields function, which returns a Boolean indicating whether or not all entries passed their edit checks. If not, we exit the sub and the record is not saved; the user remains in "update pending" mode and has the opportunity to correct the entries. Provided that validation is successful, the sub proceeds. The mstrUpdateType variable is checked to see whether we are dealing with an add or an update.
 
If we are dealing with an add, we invoke the AddNew method of the Recordset object. The AddNew method prepares a new row you can edit and subsequently add to the Recordset object using the Update method. After you modify the new row, you must use the Update method to save the changes and add the row to the result set. No changes are made to the database until you use the Update method. (The Update method is invoked after the content of the textboxes has been assigned to the database fields.)
If we are dealing with an update, we can just start modifying the fields (provided an appropriate cursor type has been selected) – unlike DAO and RDO, ADO does not use an Edit method. Changes made to the current row’s columns are copied to the copy buffer. After you make the desired changes to the row, use the Update method to save your changes or the CancelUpdate method to discard them. (If you move on to another record without invoking Update, your changes will be lost.)
The content of the textboxes is assigned to the database fields, then the Update method is invoked. The Update method saves the contents of the copy buffer row to a specified updatable Recordset object and discards the copy buffer.
The mstrUpdateType variable is checked once again, and if we are dealing with an add, there is some extra work to do. Although the new record has been added, the original resultset still does not contain the new record. The Requery method must be invoked, which updates the data in a Recordset object by re-executing the query on which the object is based. The Find method is then used to position to the new record. The ADO Find method has the following syntax:
 
RecordsetObject.Find Criteria, SkipRows, SearchDirection, Start
The Criteria argument is a String value that specifies the column name, comparison operator, and value to use in the search. Only a single-column name may be specified in criteria; multi-column searches are not supported. The comparison operator may be ">" (greater than), "<" (less than), "=" (equal), ">=" (greater than or equal), "<=" (less than or equal), "<>" (not equal), or "like" (pattern matching). The value may be a string, floating-point number, or date. String values are delimited with single quotes or "#" (number sign) marks (for example, "state = 'WA'" or "state = #WA#"). Date values are delimited with "#" (number sign) marks (for example, "start_date > #7/22/97#"). These values can contain hours, minutes, and seconds to indicate time stamps, but should not contain milliseconds or errors will occur. If the comparison operator is "like", the string value may contain an asterisk (*) to find one or more occurrences of any character or substring. For example, "state like 'M*'" matches Maine and Massachusetts. You can also use leading and trailing asterisks to find a substring contained within the values. For example, "state like '*as*'" matches Alaska, Arkansas, and Massachusetts. Asterisks can be used only at the end of a criteria string, or together at both the beginning and end of a criteria string, as shown above. You cannot use the asterisk as a leading wildcard ('*str'), or embedded wildcard ('s*r'). This will cause an error.
SkipRows is an optional Long value, whose default is zero, that specifies the row offset from the current row (or bookmark row specified by the Start argument, if present) to begin the search. By default, the search will start on the current row.
SearchDirection is an optional value that determines in which direction the search is performed. The value is specified by the constants adSearchForward (the default) or adSearchBackward, which equate to values of 1 or -1, respectively.
Start is an optional Variant bookmark that functions as the starting position for the search.
Note: Unlike DAO, ADO does not have a "NoMatch" property. If the ADO Find method is unsuccessful, the record pointer is positioned at the end of the Recordset.
The SetRecNum sub is then be called to display the status bar information about the new record. The SetFormState sub is then called with a parameter of False, which causes the textboxes and the Save and Cancel buttons to be disabled and all other buttons to be enabled.
Note that in the statement that assigns the contents of the txtAsking textbox to the asking field of the table, our UnFormatNumber function is used to strip off the non-numeric characters. This is because we are using a display format that includes a dollar sign and commas on the txtAsking control, and an error would occur if we attempted to assign this directly to the asking field, which is defined as numeric.
'-----------------------------------------------------------------------------
Private Sub cmdSave_Click()
'-----------------------------------------------------------------------------
 
On Error GoTo LocalError
 
If Not ValidateAllFields Then Exit Sub
 
If mstrUpdateType = "A" Then
mobjADORst.AddNew
Else
' We can just update the fields. No explicit Edit method
' is available or needed.
End If
'save the data to the database:
mobjADORst.Fields("propno") = txtPropNo.Text
mobjADORst.Fields("empno") = txtEmpNo.Text
mobjADORst.Fields("address") = txtAddress.Text
mobjADORst.Fields("city") = txtCity.Text
mobjADORst.Fields("state") = txtState.Text
mobjADORst.Fields("zip") = txtZip.Text
mobjADORst.Fields("beds") = txtBeds.Text
mobjADORst.Fields("baths") = txtBaths.Text
mobjADORst.Fields("asking") = UnFormatNumber(txtAsking.Text)
mobjADORst.Update
 
If mstrUpdateType = "A" Then
'after the new record is added, the db must be re-queried
'so that the resultset contains the new record:
mobjADORst.Requery
' reposition to the record just added
mobjADORst.Find "propno = " & txtPropNo.Text
'display status info about the new record
SetRecNum
End If
Reset:
SetFormState False
Exit Sub
LocalError:
MsgBox Err.Number & " - " & Err.Description
Resume Reset
End Sub
 
Code the Click event for the cmdDelete button. The user is first asked to confirm that they want to delete the record, and if so, the Delete method of the resultset object is invoked, which deletes the current row in an updatable resultset object. The Requery method is then invoked so that the record is removed from the resultset that the user is working with. The Find method is then invoked to position the next record after the deleted one. If it was the last record that was deleted, then we position to the "new" last record using the MoveLast property. PopulateFormFields must then be called to display the contents of the new current record.
 
'-----------------------------------------------------------------------------
Private Sub cmdDelete_Click()
'-----------------------------------------------------------------------------
 
On Error GoTo LocalError
'when the current record is deleted, the current location in the recordset
'is invalid. use the Requery method to re-execute the query and update
'the data.
If MsgBox("Are you sure you want to delete this record?", _
vbYesNo + vbQuestion, _
"Delete") = vbNo Then
Exit Sub
End If
mobjADORst.Delete
mobjADORst.Requery
' reposition to one past the record just deleted
mobjADORst.Find "propno > " & txtPropNo.Text
' If it was the last record that was deleted, the Find method will
' come back with EOF, in which case we should MoveLast to position
' us to the "new" last record ...
If mobjADORst.EOF Then mobjADORst.MoveLast
'load data into the text boxes:
Call PopulateFormFields
 
Exit Sub
 
LocalError:
MsgBox Err.Number & " - " & Err.Description
End Sub
 
The ValidateAllFields function, which returns a Boolean value indicating whether or not all fields have passed validation checks. This function calls upon two "helper" functions: PropertyExists and ValidState. When the user is doing an add, the PropertyExist function is called to see whether or not the proposed Property Number is already being used in the Property table. If so, the user is informed that they can't use that number (because it is the primary key and must be unique) and so they must use a different number. The ValidState routine is called to ensure that the user has entered a valid US state. The code for all three functions is shown below.
 
'-----------------------------------------------------------------------------
Private Function ValidateAllFields() As Boolean
'-----------------------------------------------------------------------------
 
ValidateAllFields = False 'guilty until proven innocent
If mstrUpdateType = "A" Then
If txtPropNo.Text = "" Then
MsgBox "Property # must not be blank.", vbExclamation, "Property #"
txtPropNo.SetFocus
Exit Function
ElseIf PropertyExists Then
MsgBox "Property # already exists. Please use a different #.", _
vbExclamation, _
"Property #"
txtPropNo.SetFocus
Exit Function
End If
End If
If txtEmpNo.Text = "" Then
MsgBox "Emp # must not be blank.", vbExclamation, "Emp #"
txtEmpNo.SetFocus
Exit Function
End If
If txtAddress.Text = "" Then
MsgBox "Address must not be blank.", vbExclamation, "Address"
txtAddress.SetFocus
Exit Function
End If
If txtCity.Text = "" Then
MsgBox "City must not be blank.", vbExclamation, "City"
txtCity.SetFocus
Exit Function
End If
If Not ValidState Then
MsgBox "Missing or invalid state.", vbExclamation, "State"
txtState.SetFocus
Exit Function
End If
If txtZip.Text = "" Or Len(txtZip.Text) = 5 Then
' it's OK
Else
MsgBox "Zip code must either be blank or exactly 5 digits.", _
vbExclamation, _
"Zip Code"
txtZip.SetFocus
Exit Function
End If
If Val(txtBeds.Text) = 0 Then
MsgBox "Beds must not be zero.", vbExclamation, "Beds"
txtBeds.SetFocus
Exit Function
End If
If Val(txtBaths.Text) = 0 Then
MsgBox "Baths must not be zero.", vbExclamation, "Baths"
txtBaths.SetFocus
Exit Function
End If
If Val(UnFormatNumber(txtAsking.Text)) = 0 Then
MsgBox "Asking must not be zero.", vbExclamation, "Asking"
txtAsking.SetFocus
Exit Function
End If
' if we make it here, all fields have passed edit
ValidateAllFields = True
End Function
 
'--------------------------------------------------------------------------------
Private Function ValidState() As Boolean
'--------------------------------------------------------------------------------
 
Dim lngX As Long
Dim blnStateFound As Boolean
blnStateFound = False
For lngX = 0 To UBound(mavntUSStates)
If txtState.Text = mavntUSStates(lngX) Then
blnStateFound = True
Exit For
End If
Next
ValidState = blnStateFound
End Function
 
'-----------------------------------------------------------------------------
Private Function PropertyExists() As Boolean
'-----------------------------------------------------------------------------
 
Dim objTempRst As New ADODB.Recordset
Dim strSQL As String
 
strSQL = "select count(*) as the_count from property where propno = " & txtPropNo.Text
objTempRst.Open strSQL, mobjADOConn, adOpenForwardOnly, , adCmdText
If objTempRst("the_count") > 0 Then
PropertyExists = True
Else
PropertyExists = False
End If
 
End Function
Code the Click event for the cmdCancel button. The user would click this button if, during an add or update, they decide to abandon the operation. Here, PopulateFormFields is called to reset the textboxes to their content prior to the user clicking the Add or Update button, and SetFormState is called with a parameter of False, which causes the textboxes and the Save and Cancel buttons to be disabled and all other buttons to be enabled.
'-----------------------------------------------------------------------------
Private Sub cmdCancel_Click()
'-----------------------------------------------------------------------------
 
PopulateFormFields
SetFormState False
End Sub
Code the Click event for the cmdExit button, which issues the Unload Me statement to fire the Form_Unload event, which will unload the form and end the application.
 
'-----------------------------------------------------------------------------
Private Sub cmdExit_Click()
'-----------------------------------------------------------------------------
 
Unload Me
End Sub