Example 5 - Database access via VBA

Description:

In the form frmAdr_DB the user can create, change and delete addresses.

In the background of the form there is an ACCESS 97 databes, where the addresses are saved.

We use an event independent macro to display frmAdr_DB, because we do not link it to an element.

SubDatabaseForm ()
frmAdr _ DB . Show
End Sub

The macro will be executed with the function Execute macro.

Declarations:

Dim strTyp As String
Dim obDb As Database
Dim obRS As Recordset

'Sub program:

'The sub program Txt_Unlock makes text error editable.

Private Sub Txt _ UnLock ()

'unlock all textboxes
txtVorname . Locked = False
txtNachname . Locked = False
txtStrasse . Locked = False
txtPlz . Locked = False
txtOrt . Locked = False
txtTel . Locked = False
txtFax . Locked = False
txtHandy . Locked = False
txtMailTo . Locked = False
End Sub

'Txt_Lock locks all text fields, the texts no longer can be edited.

Private Sub Txt _ Lock ()

'lock all textboxes
txtVorname . Locked = True
txtNachname . Locked = True
txtStrasse . Locked = True
txtPlz . Locked = True
txtOrt . Locked = True
txtTel . Locked = True
txtFax . Locked = True
txtHandy . Locked = True
txtMailTo . Locked = True
End Sub

'Txt_Clear clears all text fields.

Private Sub Txt _ Clear ()
'clear all textboxes
txtVorname . Text =
txtNachname . Text =
txtStrasse . Text =
txtPlz . Text =
txtOrt . Text =
txtTel . Text =
txtFax . Text =
txtHandy . Text =
txtMailTo . Text =
End Sub

'Txt_Fill fills all text fields with the current record.

Private Sub Txt _ Fill ()
'fill all textboxes with actual recordset
txtVorname . Text = obRS. Fields ( vorname )
txtNachname . Text = obRS. Fields ( nachname )
txtStrasse . Text = obRS. Fields ( strasse )
txtPlz . Text = obRS. Fields ( plz )
txtOrt . Text = obRS. Fields ( ort )
txtTel . Text = obRS. Fields ( tel )
txtFax . Text = obRS. Fields ( fax )
txtHandy . Text = obRS. Fields ( handy )
txtMailTo . Text = obRS. Fields ( mailto )
End Sub

'Stops editing or creating a record without saving.

Private SubcmdBack _ Click ()
obRS . Index = AdrNachname
obRS . Seek=, txtNachname . Text

If obRS . NoMatch Then
obRS . MoveFirst
End If

Txt _ Fill 'fill textboxes

'button visible = true
cmdNew . Visible = True
cmdEdit . Visible = True
cmdNext . Visible = True
cmdPrev . Visible = True
cmdLast . Visible = True
cmdFirst . Visible = True
cmdDelete . Visible = True
'save+back Button visible = false

cmdSave. Visible = False
cmdBack . Visible = False

Txt _ Lock 'lock textboxes
End Sub

'Deletes the current record.

Private Sub cmdDelete _ Click ()

'delete record
If MsgBox ( delete address ?, vbYesNo ) = vbYes Then
obRS . Delete delete recordset
obRS . MoveFirst
Txt _ Fill 'fill textboxes
End If
End Sub

'Allows editing the current record.

Private Sub cmdEdit _ Click ()
'edit a record
strTyp = EDIT
Txt _ UnLock 'unlock textboxes
txtVorname . SetFocus

'buttons visible = False
cmdNew . Visible = False
cmdEdit . Visible = False
cmdNext . Visible = False
cmdPrev . Visible = False
cmdLast . Visible = False
cmdFirst . Visible = False
cmdDelete . Visible = False

'save+back buttons visible = true
cmdSave . Visible = True
cmdBack . Visible = True
End Sub

'Closes the form.
Private Sub cmdExit _ Click ()
Unload Me 'close form
End Sub

'Shows the first record.
Private Sub cmdFirst _ Click ()

'move to the first record
obRS . MoveFirst
Txt _ Fill
End Sub

'Shows the last record.
Private Sub cmdLast _ Click ()

'move to the last record
obRS . MoveLast
Txt _ Fill
End Sub

'Allows creating a new record.
Private Sub cmdNew _ Click ()
'new record
strTyp = NEW
Txt _ UnLock 'unlock textboxes
Txt _ Clear 'clear textboxes
txtVorname . SetFocus
button visible = False
cmdNew . Visible = False
cmdEdit . Visible = False
cmdNext . Visible = False
cmdPrev . Visible = False
cmdLast . Visible = False
cmdFirst . Visible = False
cmdDelete . Visible = False

'save+back buttons visible = true
cmdSave . Visible = True
cmdBack . Visible = True
End Sub

'Shows the next record.
Private Sub cmdNext _ Click ()
'move to the next record
On Error Resume Next
obRS . MoveNext
Txt _ Fill
End Sub

'Shows the previous record.
Private Sub cmdPrev _ Click ()
'move to the previous record
On Error Resume Next
obRS . MovePrevious
Txt _ Fill
End Sub

'Saves a new or edited record.
Private Sub cmdSave _ Click ()
'saves a record

If strTyp = EDIT Then
obRS . Edit
Else
obRS . AddNew strTyp = NEW
End If

obRS . Fields ( vorname ) = txtVorname . Text
obRS . Fields ( nachname ) = txtNachname . Text
obRS . Fields ( strasse ) = txtStrasse . Text
obRS . Fields ( plz ) = txtPlz . Text
obRS . Fields ( ort ) = txtOrt . Text
obRS . Fields ( tel ) = txtTel . Text
obRS . Fields ( fax ) = txtFax . Text
obRS . Fields ( handy ) = txtHandy . Text
obRS . Fields ( mailto ) = txtMailTo . Text
obRS . Update
obRS . MoveFirst
'buttons visible = true
cmdNew . Visible = True
cmdEdit . Visible = True
cmdNext . Visible = True
cmdPrev . Visible = True
cmdLast . Visible = True
cmdFirst . Visible = True
cmdDelete . Visible = True

'save+back buttons visible = false
cmdSave . Visible = False
cmdBack . Visible = False
Txt _ Lock 'lock textboxes
End Sub