Categories of Sample Visual Basic Code:

1. Validation at Control-level
2. Run Time Error Handling Code
3. Working with Data Controls
4. Working with DB Grids
5. Data Access Objects (DAOs)
6. Using Queries that Take Parms
7. OLE Objects

Other Visual Basic Topics

1. Validation at Control-level

To "automatically" upshift data, code the keypress event:

Sub Text1_KeyPress (KeyAscii As Integer)
KeyAscii = Ascii(UCase(Char(Keyascii)))
End Sub

To limit data entered to very specific values, code the keypress event:

'this is brute-force method of limiting to number but mask is easier.
Sub Text1_KeyPress (KeyAscii As Integer)
If KeyAscii = 8 Then 'Allow BACKSPACE through
  Exit Sub
End If

'Only digits are valid characters.
If Chr(KeyAscii) < "0" Or Chr(KeyAscii) > "9" Then
  KeyAscii = 0 'Set character to null if out of range
  Beep
End If
End Sub

To Give User Feedback when they violate mask conditions, code the ValidationError event:

Sub mskID_ValidationError (InvalidText As String, StartPosition As Integer)

'Check for too many digits error. o/w user is trying to enter non-numeric.

If StartPosition = mskID.MaxLength Then
  lblError.Caption = "Limit 6 digits"
Else
  lblError.Caption = "Digits only"
End If
End Sub

LostFocus Code that Returns Focus to this Field and Avoids Infinite Loop

Dim ValidationInProgress as Boolean (available to all controls on Form)

Private Sub txtFirstName_LostFocus()
If Not (ValidationInProgress) Then 'ok to validate
  If txtFirstName.Text = "" Then
    ValidationInProgress = True
    txtFirstName.SetFocus
    lblError.Caption = "First Name is required."
    DoEvents
    ValidationInProgress = False
  End If
End If
End Sub

Note: the above example is bad for usability because they do mandatory field validation at the field (rather than Form) level. How does the user "get out" if he doesn't know the value?

Validate in LostFocus, only if data is changed

Declare "IFlag" as Integer in Form’s general declaration (can reuse this variable across both events and controls).
- In GetFocus, set IFlag = 0
- In Change, set IFlag = 1
- In LostFocus, "If IFlag = 1 Then … code for when item is changed.

** you've already lost focus by the time this event fires so you'd have to set focus back to get the user to fix it. See use of a global like "validation-in-progress" above to ensure you don't get infinite loops resetting focus.

Monitor for hot-key

code KeyPress event of the Form (instead of coding it for every control on the Form)

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyF2 Then
  MsgBox "You Pressed F2!"
End If
End Sub

Note: the KeyPreview property determines whether Form sees keystrokes before its controls.

2. Run Time Error Handling Code

RunTime Error Handler

' Call generalized procedure for error handling and check result to
' decide where to resume
Private Sub CodeWithErrorHandler()
On Error GoTo ErrHandler
'...Procedure code ...
'...
Exit Sub

ErrHandler:
'Pass error to general purpose error-handling routine
Action = HandleError(Err.Number)
'Take action based on result of function
If Action = MyResume Then
  Resume ' execute same line of code
ElseIf Action = MyResumeNext Then
  Resume Next ' execute next line of code
End If
End Sub

Private Function HandleError(ErrNum As Integer) As Integer
Select Case Err.Num
  Case 53 'File not found
    answer=MsgBox("File not found. Try again?", _
    vbYesNo)

  Case 76 'Path not found
    answer=MsgBox("Path not found. Try again?", _
    vbYesNo)

  Case Else 'unknown error
    MsgBox "Unknown error. Quitting now." 'SHOULD LOG ERROR!
    Unload Me
End Select

If answer = vbYes Then
  HandleError = MyResume 'tell calling procedure to resume
ElseIf answer = vbNo Then
  HandleError = MyResumeNext 'tell calling procedure to resume next
End If

End Function

3. Working with Data Controls

Deleting record when using Data Control

Sub cmdDelete_Click ()
Data1.Recordset.Delete
If Data1.Recordset.RecordCount = 0 Then
  'Moves to EOF marker to clear bound fields
  Data1.Recordset.MoveNext
  Msgbox "There are no more records."
  cmdDelete.Enabled = False
  Data1.Enabled = False
  cmdAdd.Enabled = True
Else
  Data1.Recordset.MoveNext
  If Data1.Recordset.EOF Then
    Data1.Recordset.MoveLast
  End If
End If
End Sub

Validate event for Data Control

Private Sub Data1_Validate (Action As Integer, Save As Integer)
' if a save is occurring, check save with user. Cancel and refresh if
' user doesn't want change.
Dim iResponse As Integer
If Save = True Then 'Data has changed and is being saved
  iResponse As Integer = MsgBox ("Really want to save?", vbYesNo)
  If iResponse = vbNo Then
    Save = False
    Data1.UpdateControls ' Refresh fields
  End If
End If
End Sub

Error event (i.e. DB Error) for Data Control

Private Sub Data1_Error(DataErr As Integer, Response As Integer)
If DataErr = 3022 Then 'Duplicate Key error
  MsgBox "Enter unique Emp ID number"
  txtEmpID.SetFocus
  Response = 0
Else
  Response = 1 'display standard error message
End If
End Sub

Modifying SQL for a Data Control – i.e. add entered values as a "Where Clause"

Private Sub cmb_Search_Click()
Dim sAddToQuery As String
Dim sLastName As String
Dim sFirstName As String
sLastName = Trim(txt_LastName.Text)
sFirstName = Trim(txt_FirstName.Text)
' Add last name to query, if specified
If sLastName <> "" Then
  sAddToQuery = " last_name Like '" & sLastName & "*'"
End If
' Add first name to query, if specified
If sFirstName <> "" Then
  If sAddToQuery <> "" Then
    sAddToQuery = sAddToQuery + " AND "
  End If
  sAddToQuery = sAddToQuery & _
  " first_name Like '" & sFirstName & "*'"
End If
'if limiting criteria was specified, modify RecordSource SQL and refresh
' data with limiting criteria

If sAddToQuery <> "" Then
  dat_results.RecordSource = sOrigQry & _
  " Where" & sAddToQuery
  dat_results.Refresh
End If
End Sub

4. Working with DB Grids

DB Grid - getting cell values out of a grid

Dim sCurrCell As String 'value of cell where cursor is
Dim sFirstCol As String 'value of first column where cursor is
sCurrCell = dbg_results.Columns(dbg_results.Col).Text
sFirstCol = dbg_results.Columns(0).Text

DB Grid - setting a cell value (and updating DB)

'Note that the Data Control (not the DB Grid) is referred to for the update
dat_results.Recordset.Edit
dat_results.Recordset.Fields("last_name") = "Jones"
dat_results.Recordset.Update

DB Grid - selecting a row on a grid

' if user clicks on a cell, highlight the whole row
Private Sub dbg_results_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
dbg_results.SelBookmarks.Add dbg_results.RowBookmark(dbg_results.Row)
End Sub

DB Grid - getting values out of selected row(s) on a grid

' loop and pick out required grid values for all selected rows
Dim I
ReDim sSelectedName(0 To dbg_results.SelBookmarks.Count - 1) As String
ReDim CalcArray(0 To dbg_results.SelBookmarks.Count - 1)
For I = 0 To dbg_results.SelBookmarks.Count - 1
  ' Puts the value of the current row in the selected row array.
  sSelectedName [I]= _
  dbg_results.Columns(1).CellValue(dbg_results.SelBookmarks(I)) & _
  dbg_results.Columns(2).CellValue(dbg_results.SelBookmarks(I))
Next I

5. Data Access Objects (DAOs)

Setup and Use of Data Access Object (DAO) for Window that Maintains one Row at a Time

A. Under Tools-References, be sure to set up Microsoft DAO 3.0 Object Library if using 32-bit applications.

B. See 15-page writeup on DAOs from VB4 tutorial CD (in PB5/VB5 box) for details.

In brief, here is how to setup a window that maintains one row at a time, using DAO:
5.1 Connect to DB , probably as App starts
Set db = OpenDatabase("Home_vb_DB.mdb")

5.2 Setup RecordSet (e.g. tablename or SQL Select or Query?), probably in Form load
Set rs = db.OpenRecordset("Person_1")

5.3 Position to start of recordset, probably in Form load
rs.MoveFirst
f_SetFields <-- write this to move fields from recordset to Form Controls

5.4 Write f_SetFields (from rs), f_GetFields (to rs), f_ClearFields
f_SetFields (text control)
If IsNull(rs("person_no")) Then
  txtPersonNo.Text = "-Null-" 'assigning null would cause runtime error
Else
  txtPersonNo.Text = rs("person_no")
End If
'alternate method of guarding against Null for string
textDescription = rs("desc") & "" 

f_SetFields (dbcombo Control)
If IsNull(rs("title_id")) Then
  'assigning empty string to text, effectively empties out BoundText
  dbcTitle.Text = ""
Else
  'value is assigned to BoundText (for translation to desc)
  dbcTitle.BoundText = rs("title_id")
End If

f_GetFields (text control)
rs("person_no") = txtPersonNo.Text

f_GetFields (dbcombo Control)
rs("title_id") = dbcTitle.BoundText

f_ClearFields (either)
txtPersonNo.Text = ""
dbcTitle.Text = ""

5.5 Write button code (add to insert row, Update to save row, Delete to remove record, Refresh to simply pull back original values from recordset)

Add:
f_ClearFields
rs.AddNew

Update:
On Error GoTo HandleError
If rs.EditMode = dbEditNone Then
  rs.Edit
End If
f_GetFields
rs.Update
Exit Sub
HandleError:
MsgBox Err.Number & " : " & Err.Description
rs.CancelUpdate

Delete:
On Error GoTo HandleError
rs.Delete
… plus standard MoveNext code
HandleError:
MsgBox Err.Number & " : " & Err.Description 'no cancel needed, user just stays there

Refresh:
f_SetFields

Note: See #5.7 Nicer code for Add and Save button

5.6 Code MoveNext, MovePrevious, MoveFirst, MoveLast buttons
MoveNext:
rs.MoveNext
If rs.EOF Then
  Beep
  rs.MoveLast
End If
f_SetFields

5.7 Nicer behaviour for Add, Save, Cancel buttons (actual add to recordset only occurs when save hit)

Private Sub cmdAdd_Click()
AddingRecord = True
clearFields
ButtonEditAddMode 'User written procedure.
'Enables buttons
CurrentRecord = rs.Bookmark
End Sub

Private Sub cmdSave_Click()
On Error GoTo HandleError
If AddingRecord Then 'Adding a new record
  rs.AddNew
  rs.Fields("Category Name") = txtCategoryName.Text
  rs.Fields("Description") = txtDescription.Text
  rs.Update
  AddingRecord = False
Else 'Editing the current record
  rs.Edit
  rs.Fields("Category Name") = txtCategoryName.Text
  rs.Fields("Description") = txtDescription.Text
  rs.Update
End If
rs.Bookmark = rs.LastModified
FillFields 'User written procedure to fill Form
ButtonNavigateMode
Exit Sub

HandleError:
MsgBox Err.Number & ": " & Err.Description
rs.CancelUpdate
End Sub

Private Sub cmdCancel_Click()
FillFields
ButtonNavigateMode
End Sub

6. Using Queries that Take Parms (see also points in "How Tos")

Defining Query with Parms and then Retrieving using Parms through DOA

1. Define Query in Database, including its parameters – my query called FindName
PARAMETERS [LastName] Text, [FirstName] Text;
SELECT *
FROM Person_1
WHERE Last_Name Like [LastName] AND
      First_Name Like [FirstName]

2. Setup Query, then assign its parameters, then assign recordset (i.e. retrieve)
Dim db as Database
Dim Q as QueryDef
Set db = OpenDatabase("Home_vb_DB.mdb")
Set Q = db.QueryDefs("FindName")
sLName = "W" & "*"
sFName = "L" & "*"
'need to assign actual type. Use conversion, if needed (e.g. CDate())
Q.Parameters("LastName") = sLName 

Q.Parameters("FirstName") = sFName
Set rs = Q.OpenRecordset

Note on add line: set datPerson.RecordSource = rs to get this to work for Data Control.
Also, Data Control cannot be set to query that takes parm in design (see How To for alternatives).

7. Dynamically Creating Excel and Word OLE Objects

MS EXCEL Example

Dim x1 as Object 'either put this declaration at Form level or make it static.
Set x1 = CreateObject("Excel.Application")
x1.Visible = True
x1.Workbooks.Add 'next three commands specific to object
x1.Range("A1").Value = "Hello World"
' assign value in spreadsheet to a control on our Form
x1.Range("A2").Value = txtPerson.text

xl.Workbooks.Open "c:\invoice.xls" 'open another doc
x1.ActiveWorkbook.Close ! close workbook (follow by "False" for no prompt)
x1.Quit !close App

Excel Example, with Error Handling

Dim xl As Excel.Application
Dim xlwb As Excel.WorkBook
On Error Resume Next
set xl = CreateObject ("Excel.Application")
set xlwb = xl.Workbooks.Open ("c:\book1.xls ")
If Err <> 0 Then
  MsgBox "Unable to open workbook"
  UnLoad Me
End If

MS WORD Example

'either put this declaration at Form level or make it static.
'Otherwise, object is destroyed when script has run
Dim wd As Object
Set wd = CreateObject ("Word.Basic")
wd.AppShow
wd.FileNewDefault
wd.FontSize 24
wd.Insert "Hello, World"

More Sample Word Code

wd.FileOpen "MyDoc.Doc"
wd.FileNewDefault
wd.FileNew "invoice.dot" 'template name
wd.FileSave
wd.FileSaveAs "NEWNAME.DOC"
wd.FileClose
wd.Fileprint
Set wd = Nothing 'closes Word if no one else is using it

Note on creating MS Word OLE Objects:
Most WordBasic method names match the menu selection, and the parameters match the dialog box items. You can also use the Word macro recorder to create code, and then copy that code to your Visual Basic application.

Copyright © Woodger Computing Inc.