Sample Visual Basic Applications Source Code

This sample was created and used in Microsoft Access '97.

Option Compare Database
Option Explicit
Dim Db As Database
Dim Cust As Recordset

Sub LoadFields()

On Error GoTo Err_LoadFields

Text1.Value = ""
Text2.Value = ""
Text3.Value = ""
Text4.Value = ""

Text1.Value = Cust(0).Value
Text2.Value = Cust(1).Value
Text3.Value = Cust("LAST_NAME").Value
Text4.Value = Cust("FIRST_NAME").Value

Exit_LoadFields:
Exit Sub

Err_LoadFields:
If Err.Number = 3021 Then
Cust.MoveFirst
Resume
End If
MsgBox Err.Description
MsgBox Err.Number
Resume Exit_LoadFields

End Sub

Private Sub Form_Open(Cancel As Integer)

Dim Connect As String
Dim SQL As String

On Error GoTo Err_Form_Open

Connect$ = "ODBC;DSN=MSDB;"
Set Db = OpenDatabase("", dbDriverNoPrompt, True, Connect$)

SQL = "SELECT * FROM CONTACTS "
Set Cust = Db.OpenRecordset(SQL, dbOpenDynaset)

Cust.MoveFirst
LoadFields
Exit Sub

Err_Form_Open:
MsgBox Err.Description, vbCritical
End

End Sub

Private Sub Command1_Click()
On Error GoTo Err_Command1_Click

Cust.MoveNext
If Cust.EOF Then
MsgBox "EOF"
End If
LoadFields

Exit_Command1_Click:
Exit Sub

Err_Command1_Click:
MsgBox Err.Description
Resume Exit_Command1_Click

End Sub

Private Sub Command2_Click()
On Error GoTo Err_Command2_Click


Cust.MovePrevious
If Cust.BOF Then
MsgBox "BOF"
End If
LoadFields

Exit_Command2_Click:
Exit Sub

Err_Command2_Click:
MsgBox Err.Description
Resume Exit_Command2_Click

End Sub

Private Sub Command3_Click()

Dim SQL As String

On Error GoTo Err_Command3_Click

If (Len(Text2.Value) < 1) Then
SQL = "SELECT * FROM CONTACTS"
Else
SQL = "SELECT * FROM CONTACTS WHERE CONTACT_NUMBER = '" & _
Format(Text2.Value, "000000") & "'"
End If

Set Cust = Db.OpenRecordset(SQL, dbOpenDynaset)
MsgBox Cust.RecordCount
LoadFields

Exit_Command3_Click:
Exit Sub

Err_Command3_Click:
MsgBox Err.Description
Resume Exit_Command3_Click

End Sub