Overview
This article details how to create your own Access 2000 validation routines. While Access 2000 has its own validation rules that you can create for each control, I've found it easier to use Visual Basic techniques to validate data.
You may wonder why these validation routines were created in Access when the data types and bound controls could prevent most of the data errors. In truth, I use these routines to validate using Active Server Pages by converting the validation routines to Javascript. The Javascript was converted to vbascript and run in this Access 2000 demonstration.
You may find creating your own validation routines more flexible and functional than the built-in validation rules in Access.
Objective: To be able to determine if the user input is a valid number, a date, in a list, within a number range, or a field value in a table.
Basic Setup
- One command button named "cmdValidate"
- Five text boxes:
a. txtNumber
b. txtDate
c. txtList
d. txtRange
e. txtInTable
Code
Option Explicit
Option Compare Database
Purpose: The Validate button has been pressed by the user. Each validation type is run.
The IsIntable validation function assumes you have a table called processes with a field named processname.
Private Sub cmdValidate_Click()
Dim errorMessage As String
Dim List(3) As String
List(0) = "Hello"
List(1) = "World"
List(2) = "Utah"
Call IsaNumber(txtNumber, errorMessage)
Call IsaDate(txtDate, errorMessage)
Call IsaListItem(txtList, errorMessage, List)
Call IsInRange(txtRange, errorMessage, 3, 5)
Call IsInTable(txtInTable, errorMessage, "processes", "processname", "STRING")
msgbox errorMessage
End Sub
Purpose: Validates the user input is a number.
Public Sub IsaNumber(objText As TextBox, errormsg As String)
On Error GoTo IsANumber_Error
objText.SetFocus
If IsNumeric(objText.Text) = False Then
errormsg = errormsg & objText.name & ":" & objText.Text & " is not numeric " & Chr(13) & Chr(10)
objText.BackColor = &HFF&
Else
objText.BackColor = &HFFFFFF
End If
Exit_IsaNumber:
Exit Sub
IsANumber_Error:
#If gnDebug Then
Stop
Resume
#End If
msgbox Err.Description & ":" & Err.Number
Resume Exit_IsaNumber
End Sub
Purpose: Validates the user input is a date.
Public Sub IsaDate(objText As TextBox, errormsg As String)
On Error GoTo IsaDate_Error
objText.SetFocus
If IsDate(objText.Text) = False Then
errormsg = errormsg & objText.name & ":" & objText.Text & " is not a date " & Chr(13) & Chr(10)
objText.BackColor = &HFF&
Else
objText.BackColor = &HFFFFFF
End If
Exit_IsaDate:
Exit Sub
IsaDate_Error:
#If gnDebug Then
Stop
Resume
#End If
msgbox Err.Description & ":" & Err.Number
Resume Exit_IsaDate
End Sub
Purpose: A list of valid choices are checked against the user's input. The text
comparison is not case sensitive.
Public Sub IsaListItem(objText As TextBox, errormsg As String, List() As String)
On Error GoTo IsaListItem_Error
Dim sValue
Dim i
Dim bFound
objText.SetFocus
sValue = objText.Value
bFound = False
For i = 0 To UBound(List) - 1
If ucase(List(i)) = ucase(sValue) Then
bFound = True
Exit For
End If
Next
If bFound = False Then
errormsg = errormsg & objText.name & ":" & objText.Text & " is not a valid entry " & Chr(13) & Chr(10)
objText.BackColor = &HFF&
Else
objText.BackColor = &HFFFFFF
End If
Exit_IsaListItem:
Exit Sub
IsaListItem_Error:
#If gnDebug Then
Stop
Resume
#End If
msgbox Err.Description & ":" & Err.Number
Resume Exit_IsaListItem
End Sub
Purpose: Validates the user input is a numeric value within a certain
upper and lower range.
Public Sub IsInRange(objText As TextBox, errormsg As String, _
lowerlimit As Integer, upperlimit As Integer)
On Error GoTo IsInRange_Error
Dim sValue
objText.SetFocus
Call IsaNumber(objText, errormsg)
If IsNull(objText.Value) Then
sValue = 0
Else
sValue = objText.Value
End If
If sValue < lowerlimit Or sValue > upperlimit Then
errormsg = errormsg & objText.name & ":" & objText.Text & " is not in range " & Chr(13) & Chr(10)
objText.BackColor = &HFF&
Else
objText.BackColor = &HFFFFFF
End If
Exit_IsInRange:
Exit Sub
IsInRange_Error:
#If gnDebug Then
Stop
Resume
#End If
msgbox Err.Description & ":" & Err.Number
Resume Exit_IsInRange
End Sub
Purpose: The user input is validated to be a field value for an Access 2000 table. Usually, a bound combo box is used to select a valid field value. However, you may have a need to check for valid database matching.
Public Sub IsInTable(objText As TextBox, errormsg As String, tablename As String, _
fieldname As String, datetype As String)
On Error GoTo IsInTable_Error
Dim sValue
Dim rs
Dim sql
Dim bFound
objText.SetFocus
sValue = objText
If datetype = "STRING" Then
sql = "select * from " & tablename & " where ucase(" & fieldname & ")=" & IsNVLString(UCase(sValue))
ElseIf datetype = "DATE" Then
Call IsaDate(objText, errormsg)
sql = "select * from " & tablename & " where " & fieldname & "=" & IsNVLDate(sValue)
ElseIf datetype = "NUMERIC" Then
Call IsaNumber(objText, errormsg)
sql = "select * from " & tablename & " where " & fieldname & "=" & IsNVLNumber(sValue)
End If
Set rs = CurrentDB().OpenRecordset(sql)
bFound = False
If Not rs.EOF Then
bFound = True
End If
rs.Close
Set rs = Nothing
If bFound = False Then
errormsg = errormsg & objText.name & ":" & objText.Text & " is not in table " & Chr(13) & Chr(10)
objText.BackColor = &HFF&
Else
objText.BackColor = &HFFFFFF
End If
Exit_IsInTable:
Exit Sub
IsInTable_Error:
#If gnDebug Then
Stop
Resume
#End If
msgbox Err.Description & ":" & Err.Number
Resume Exit_IsInTable
End Sub
Purpose: Returns a single quote enclosed string, with embedded single quotes
being converted into double single quotes. If the parameter is an empty string, than return a null.
Function IsNVLString(parameter)
On Error GoTo IsNVLString_Error
If IsNull(parameter) Or parameter = "" Then
IsNVLString = "Null"
GoTo Exit_IsNVLString
End If
IsNVLString = "'" & FixApostrophy(parameter) & "'"
Exit_IsNVLString:
Exit Function
IsNVLString_Error:
#If gnDebug Then
Stop
Resume
#End If
msgbox Err.Description & ":" & Err.Number
Resume Exit_IsNVLString
End Function
Purpose: Return either a number or a null.
Function IsNVLNumber(parameter)
On Error GoTo IsNVLNumber_Error
If IsNull(parameter) Or parameter = "" Then
IsNVLNumber = "Null"
GoTo Exit_IsNVLNumber
End If
IsNVLString = parameter
Exit_IsNVLNumber:
Exit Function
IsNVLNumber_Error:
#If gnDebug Then
Stop
Resume
#End If
msgbox Err.Description & ":" & Err.Number
Resume Exit_IsNVLNumber
End Function
Purpose: Return a # enclosed string if the user data
is a date type or null if the parameter is empty.
Function IsNVLDate(parameter)
On Error GoTo IsNVLDate_Error
If IsNull(parameter) Or parameter = "" Then
IsNVLDate = "Null"
GoTo Exit_IsNVLDate
End If
IsNVLDate = "#" & parameter & "#"
Exit_IsNVLNumber:
Exit Function
IsNVLNumber_Error:
#If gnDebug Then
Stop
Resume
#End If
msgbox Err.Description & ":" & Err.Number
Resume Exit_IsNVLNumber
End Function
Purpose: Replace each single quote with two single quotes.
Public Function FixApostrophy(ByVal sSQL As String)
Dim sFront$, sBack$, nParamLen%
Dim sPhrase As String
Dim wLength As Integer
Dim i As Integer
On Error GoTo FixApostrophy_Error
wLength = Len(sSQL)
For i = 1 To wLength
If Mid$(sSQL, i, 1) = "'" Then
sPhrase = sPhrase + "''"
Else
sPhrase = sPhrase + Mid$(sSQL, i, 1)
End If
Next
FixApostrophy = sPhrase
Exit_FixApostrophy:
Exit Function
FixApostrophy_Error:
#If gnDebug Then
Stop
Resume
#End If
'Standard error handling statement
msgbox Err.Description & ":" & Err.Number
Resume Exit_FixApostrophy
End Function
Back to Access 2000 How To's Series Home
