Home
Up
 

DATABASE: Link to a database via code and manipulate records

Form layout and controls are shown below:

You need to include the references shown below

Use the Menu Bar and select: Project -->>References

Control Objects Required:

Control Properties:

Typical Code:

Option Explicit ' all variables must be declared
'defined in General
Dim SQLStatement As String           'used for SQL string
Dim cnn As ADODB.Connection     'define the connection object
Dim rs As ADODB.Recordset         'define the record-set object
Dim strcn As String                         'connection string parameter list
Dim SQL As String                         'SQL statement
Dim ErrorFlag As Boolean              'flag any errors
Dim ErrorMessage As String          'error message


Private Sub CmdRecAdd_Click()
    ' add a new record
    AddNewRecord
End Sub

Private Sub CmdRecClear_Click()
    ' clear data in text fields
    TxtID.Text = ""
    TxtFirstName.Text = ""
    TxtLastName.Text = ""
    TxtSection.Text = ""
End Sub

Private Sub CmdRecDelete_Click()
    On Error GoTo Err_handler

    rs!ID = TxtID.Text
    rs.Delete
    rs.MoveNext
    If rs.EOF = True Then
        rs.MoveFirst
    End If

    MoveRecord

    Exit Sub
Err_handler:
ProcessError
End Sub

Private Sub CmdRecUpdate_Click()
    On Error GoTo Err_handler

    rs!ID = TxtID.Text
    rs!FirstName = TxtFirstName.Text
    rs!LastName = TxtLastName.Text
    rs!Section = TxtSection.Text
    rs.Update

Exit Sub
Err_handler:
ProcessError
End Sub

Private Sub CmdExit_Click()
    DBCloseNExit
End Sub

Private Sub CmdFirstRec_Click()
    On Error GoTo Err_handler

    rs.MoveFirst

    MoveRecord ' display the record data in the textboxes on the form

    Exit Sub
Err_handler:
ProcessError
End Sub

Private Sub CmdLastRec_Click()
    On Error GoTo Err_handler
    rs.MoveLast

    MoveRecord ' display the record data in the textboxes on the form

    Exit Sub
Err_handler:
ProcessError
End Sub

Private Sub CmdNextRec_Click()
    On Error GoTo Err_handler

    rs.MoveNext
    'if at the end of the recordset, then go to
    'first record of recordset
    If rs.EOF = True Then
        rs.MoveFirst
    End If

    MoveRecord ' display the record data in the textboxes on the form

    Exit Sub
Err_handler:
ProcessError
End Sub

Private Sub CmdPreviousRec_Click()
    On Error GoTo Err_handler

    rs.MovePrevious
    'if at the beginning of the recordset, then go to
    'last record of the recordset
    If rs.BOF = True Then
        rs.MoveLast
    End If

    MoveRecord ' display the record data in the textboxes on the form

    Exit Sub
Err_handler:
ProcessError
End Sub



Private Sub Form_Load()
    On Error GoTo Err_handler

    Set cnn = New ADODB.Connection 'create connection object
    Set rs = New ADODB.Recordset 'create recordset object

    'create the connection string to the database
    strcn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path &         "\STUDENTS.mdb;Persist Security Info=False"

    cnn.ConnectionString = strcn 'assign the connection string parameters
    cnn.Open 'open the connection object to establish connection
    rs.ActiveConnection = cnn 'set up the specific connection for the given recordset object

    ' concatenating SQL statement from multiple lines
    ' selects which fields and table to conect to
    SQLStatement = "SELECT * "
    SQL = SQLStatement & " FROM Personal"

    'open the recordset to extract the sql statement
    rs.Open SQL, cnn, adOpenKeyset, adLockPessimistic

    'show the first record at the start session
    If rs.RecordCount = 0 Then
        MsgBox "There are no records in the specified recordset", vbOKOnly, "Error Message"
        DBCloseNExit
    End If

    rs.MoveFirst
    MoveRecord ' display the record data in the textboxes on the form

    Exit Sub
Err_handler:
ProcessError
End Sub

Public Sub MoveRecord()
    On Error GoTo Err_handler

    'move the data from the fields of the recordset to the textboxes on the form
    TxtID.Text = rs!ID
    TxtFirstName.Text = rs!FirstName
    TxtLastName.Text = rs!LastName
    TxtSection.Text = rs!Section

    Exit Sub
Err_handler:
ProcessError
End Sub


Public Sub DBCloseNExit()
    On Error GoTo Err_handler

    rs.Close
    Set rs = Nothing
    cnn.Close
    Set cnn = Nothing
    End

    Exit Sub
Err_handler:
    Dim ReturnCode As Integer
    ProcessError
    ReturnCode = MsgBox("Do you want to exit", vbYesNo + vbInformation, "Message ")
    If ReturnCode = vbYes Then
        End
    End If
End Sub

Public Sub ProcessError()
    Dim MessageStr As String

    MessageStr = "Error number: " & Err.Number & vbCrLf & Err.Description
    MsgBox MessageStr, vbOKOnly + vbCritical, "Error"

End Sub

Public Sub AddNewRecord()
    On Error GoTo Err_handler

    rs.AddNew
    rs!ID = Trim(TxtID.Text)
    rs!FirstName = TxtFirstName.Text
    rs!LastName = TxtLastName.Text
    rs.Update

    Exit Sub
Err_handler:
ProcessError
End Sub