Wrox Programmer Forums
|
VB Databases Basics Beginning-level VB coding questions specific to using VB with databases. Issues not specific to database use will be redirected to other forums.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the VB Databases Basics section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
 
Old August 24th, 2006, 01:40 PM
Registered User
 
Join Date: Jan 2006
Posts: 6
Thanks: 0
Thanked 0 Times in 0 Posts
Send a message via Yahoo to sime_tyres
Default save, edit, and delete

i need help to save, edit, and delete from database, using form in VB 6.0. the type of database is MS Access. my database name voting.mdb, locate C:\Voting system\voting.mdb.please help me, how i want to add n save the data from the texfield into the attribute in the voting.mdb.

 
Old September 1st, 2006, 09:45 PM
Authorized User
 
Join Date: Aug 2006
Posts: 13
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Hi sime tyres!

I hope this will be of help. Below is a sample vb6 class called clsDrivers. It is part of the DB_Server.vbp (when compiled becomes DB_Server.dll).
I write vb6 programs using the 3-tier approach. The following functions are called by the procedures in the DB_Client.vbp (when compiled becomes the DB_Client.exe).

Option Explicit
Dim strSQL As String ' declare a string
Dim conDB As ADODB.Connection ' declare a database connection


Private Sub Class_Initialize()
Set conDB = New ADODB.Connection
'conDB.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
' "Data Source =C:\LUECO\MotorPool.mdb"
conDB.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
         "Data Source =D:\LUECO\MotorPool.mdb"
End Sub

Private Sub Class_Terminate()
Set conDB = Nothing
End Sub

Public Function Add_Driver(strID As String, strLast As String, strFirst As _
   String, strLicense As String, dtExpiry As Date) As Boolean
Dim rsDrivers As New ADODB.Recordset

On Error GoTo ErrHandler

conDB.Open
conDB.CursorLocation = adUseServer

strSQL = "SELECT * FROM drivers WHERE 1=2"
rsDrivers.LockType = adLockOptimistic
rsDrivers.CursorType = adOpenKeyset
rsDrivers.Open strSQL, conDB

conDB.BeginTrans
With rsDrivers
   .AddNew
   .Fields("Driver_ID") = strID
   .Fields("Last_Name") = strLast
   .Fields("First_Name") = strFirst
   .Fields("License_No") = strLicense
   .Fields("Expiry_Date") = dtExpiry
   .Update
End With
conDB.CommitTrans
Add_Driver = True
conDB.Close
Exit Function

ErrHandler:
   Debug.Print "Error No. : " & Err.Number
   Debug.Print "Description: " & Err.Description
   conDB.RollbackTrans
   conDB.Close
   Add_Driver = False
End Function

Public Function Update_Driver(strID As String, strLast As String, strFirst As _
   String, strLicense As String, dtExpiry As Date) As Boolean
Dim rsDrivers As New ADODB.Recordset

On Error GoTo ErrHandler

conDB.Open
conDB.CursorLocation = adUseServer

strSQL = "SELECT * FROM drivers WHERE Driver_ID ='" & strID & "'"
rsDrivers.LockType = adLockOptimistic
rsDrivers.CursorType = adOpenKeyset
rsDrivers.Open strSQL, conDB

conDB.BeginTrans
With rsDrivers
   .Fields("Last_Name") = strLast
   .Fields("First_Name") = strFirst
   .Fields("License_No") = strLicense
   .Fields("Expiry_Date") = dtExpiry
   .Update
End With
conDB.CommitTrans
Update_Driver = True
conDB.Close
Exit Function

ErrHandler:
   Debug.Print "Error No. : " & Err.Number
   Debug.Print "Description: " & Err.Description
   conDB.RollbackTrans
   conDB.Close
   Update_Driver = False
End Function

Public Function Delete_Driver(strID As String) As Boolean
On Error GoTo ErrHandler

conDB.Open
conDB.CursorLocation = adUseServer

strSQL = "DELETE FROM drivers WHERE Driver_ID ='" & strID & "'"
conDB.BeginTrans
conDB.Execute strSQL
conDB.CommitTrans
Delete_Driver = True
conDB.Close
Exit Function

ErrHandler:
   Debug.Print "Error No. : " & Err.Number
   Debug.Print "Description: " & Err.Description
   conDB.RollbackTrans
   conDB.Close
   Delete_Driver = False
End Function

Public Function Select_Driver(Optional strID As String) As ADODB.Recordset
Dim rsDrivers As New ADODB.Recordset

On Error GoTo ErrHandler

conDB.Open
conDB.CursorLocation = adUseServer

strSQL = "SELECT * FROM drivers"
If Trim("" & strID) <> "" Then
   strSQL = strSQL & " WHERE Driver_ID ='" & strID & "'"
End If
strSQL = strSQL & " ORDER BY Last_Name, First_Name"
rsDrivers.LockType = adLockOptimistic
rsDrivers.CursorType = adOpenKeyset
rsDrivers.Open strSQL, conDB
Set Select_Driver = rsDrivers
Exit Function

ErrHandler:
   Debug.Print "Error No. : " & Err.Number
   Debug.Print "Description: " & Err.Description
   conDB.Close
   Set Select_Driver = Nothing
End Function

Public Function Select_Driver_ByName(strLast As String, strFirst As String) As _
   ADODB.Recordset
Dim rsDrivers As New ADODB.Recordset

On Error GoTo ErrHandler

conDB.Open
conDB.CursorLocation = adUseServer

strSQL = "SELECT * FROM drivers"
strSQL = strSQL & " WHERE Last_Name ='" & strLast & "'"
strSQL = strSQL & " AND First_Name ='" & strFirst & "'"
strSQL = strSQL & " ORDER BY Last_Name, First_Name"
rsDrivers.LockType = adLockOptimistic
rsDrivers.CursorType = adOpenKeyset
rsDrivers.Open strSQL, conDB
Set Select_Driver_ByName = rsDrivers
Exit Function

ErrHandler:
   Debug.Print "Error No. : " & Err.Number
   Debug.Print "Description: " & Err.Description
   conDB.Close
   Set Select_Driver_ByName = Nothing
End Function

'------------------------------------------
this is the frmDrivers of the DB_Client.vbp
it uses the clsDrivers of the DB_Server.vbp
to perform the tasks.
-------------------------------------------
Option Explicit
Dim iCurrentState As Integer

Private Sub cmdAdd_Click()
iCurrentState = NOW_ADDING
clearFields
lockFields (False)
txtDriverID.SetFocus
cmdAdd.Enabled = False
cmdEdit.Enabled = False
cmdDelete.Enabled = False
cmdExit.Enabled = False
cmdOK.Enabled = True
cmdCancel.Enabled = True
End Sub

Private Sub cmdCancel_Click()
iCurrentState = NOW_IDLE
clearFields
lockFields (True)
cmdAdd.Enabled = True
cmdEdit.Enabled = False
cmdDelete.Enabled = False
cmdExit.Enabled = True
cmdOK.Enabled = False
cmdCancel.Enabled = False
End Sub

Private Sub cmdDelete_Click()
Dim strWarning As String

strWarning = "Deleting this record will remove it permanently" & vbCrLf & _
             "from the database. Are you sure you want to proceed?"
If MsgBox(strWarning, vbYesNo, progname) = vbYes Then
   deleteDriver
End If
End Sub

Private Sub cmdEdit_Click()
iCurrentState = NOW_EDITING
lockFields (False)
txtDriverID.Locked = True
txtDriverID.BackColor = vbCyan
txtLastName.SetFocus
cmdAdd.Enabled = False
cmdEdit.Enabled = False
cmdDelete.Enabled = False
cmdExit.Enabled = False
cmdOK.Enabled = True
cmdCancel.Enabled = True
End Sub

Private Sub cmdExit_Click()
Unload Me
End Sub

Private Sub cmdOK_Click()
If validEntries() Then
   If iCurrentState = NOW_ADDING Then
      If noDupe() Then
         saveNewDriver
      Else
         MsgBox "Duplicate driver record id found.", vbInformation, progname
         txtDriverID.SetFocus
         Exit Sub
      End If
   ElseIf iCurrentState = NOW_EDITING Then
      updateDriver
   End If
End If
End Sub

Private Sub Form_Activate()
iCurrentState = NOW_IDLE
clearFields
lockFields (True)
populateDrivers
cmdAdd.Enabled = True
cmdEdit.Enabled = False
cmdDelete.Enabled = False
cmdExit.Enabled = True
cmdOK.Enabled = False
cmdCancel.Enabled = False
End Sub

Private Sub Form_Load()
iCurrentState = NOW_IDLE
End Sub

Private Sub lvDrivers_Click()
If lvDrivers.ListItems.Count >= 1 Then
   getDriver
Else
   MsgBox "There are no driver records listed yet.", vbInformation, progname
End If
End Sub

Private Sub txtDriverID_GotFocus()
If iCurrentState = NOW_EDITING Then
   MsgBox "This is locked when program is in edit mode." & vbCrLf & _
          "Change/modification not allowed.", vbInformation, progname
   Exit Sub
End If
hiLite
End Sub

Private Sub txtDriverID_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
   SendKeys "{TAB}"
   KeyAscii = 0
End If
End Sub

Private Sub txtFirstName_GotFocus()
hiLite
End Sub

Private Sub txtFirstName_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
   SendKeys "{TAB}"
   KeyAscii = 0
End If
End Sub

Private Sub txtLastName_GotFocus()
hiLite
End Sub

Private Sub txtLastName_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
   SendKeys "{TAB}"
   KeyAscii = 0
End If
End Sub

Private Function noDupe() As Boolean
Dim objMpool As New MPool_Server.clsDrivers
Dim rsRec As New ADODB.Recordset

Set rsRec = objMpool.Select_Driver(Trim(txtDriverID.Text))
If rsRec.EOF And rsRec.BOF Then
   Set rsRec = Nothing
   Set objMpool = Nothing

   noDupe = True
Else
   Set rsRec = Nothing
   Set objMpool = Nothing

   noDupe = False
End If
End Function

Private Function validEntries() As Boolean
validEntries = True
If iCurrentState = NOW_ADDING Then
   If txtDriverID.Text = "" Then
      validEntries = False
      txtDriverID.SetFocus
      MsgBox "Driver id must not be blank or empty.", vbInformation, progname
      Exit Function
   End If
End If
If txtLastName.Text = "" Then
   validEntries = False
   txtLastName.SetFocus
   MsgBox "Driver last name must not be blank or empty.", vbInformation, progname
   Exit Function
End If
If txtFirstName.Text = "" Then
   validEntries = False
   txtFirstName.SetFocus
   MsgBox "Driver first name must not be blank or empty.", vbInformation, progname
   Exit Function
End If
End Function

Private Sub saveNewDriver()
Dim objMpool As New MPool_Server.clsDrivers
Dim bSaved As Boolean

iCurrentState = NOW_SAVING
bSaved = objMpool.Add_Driver(Trim(txtDriverID.Text), Trim(txtLastName.Text), _
   Trim(txtFirstName.Text), Trim(txtLicNum.Text), CDate(txtLicExpiry.Text))
If bSaved = True Then
   MsgBox "Driver record added to database.", vbInformation, progname
Else
   MsgBox "Driver record was not added to database.", vbInformation, progname
End If
Set objMpool = Nothing

iCurrentState = NOW_IDLE
clearFields
lockFields (True)
populateDrivers
cmdAdd.Enabled = True
cmdEdit.Enabled = False
cmdDelete.Enabled = False
cmdExit.Enabled = True
cmdOK.Enabled = False
cmdCancel.Enabled = False
End Sub

Private Sub updateDriver()
Dim objMpool As New MPool_Server.clsDrivers
Dim bSaved As Boolean

iCurrentState = NOW_SAVING
bSaved = objMpool.Update_Driver(Trim(txtDriverID.Text), Trim(txtLastName.Text), _
   Trim(txtFirstName.Text), Trim(txtLicNum.Text), CDate(txtLicExpiry.Text))
If bSaved = True Then
   MsgBox "Driver record successfullly updated.", vbInformation, progname
Else
   MsgBox "Driver record update failed.", vbInformation, progname
End If
Set objMpool = Nothing

iCurrentState = NOW_IDLE
clearFields
lockFields (True)
populateDrivers
cmdAdd.Enabled = True
cmdEdit.Enabled = False
cmdDelete.Enabled = False
cmdExit.Enabled = True
cmdOK.Enabled = False
cmdCancel.Enabled = False
End Sub

Private Sub deleteDriver()
Dim objMpool As New MPool_Server.clsDrivers
Dim bDeleted As Boolean

iCurrentState = NOW_DELETING
bDeleted = objMpool.Delete_Driver(Trim(txtDriverID.Text))
If bDeleted = True Then
   MsgBox "Driver record successfullly removed.", vbInformation, progname
Else
   MsgBox "Driver record delete failed.", vbInformation, progname
End If
Set objMpool = Nothing

iCurrentState = NOW_IDLE
clearFields
lockFields (True)
populateDrivers
cmdAdd.Enabled = True
cmdEdit.Enabled = False
cmdDelete.Enabled = False
cmdExit.Enabled = True
cmdOK.Enabled = False
cmdCancel.Enabled = False
End Sub

Private Sub populateDrivers()
Dim objMpool As New MPool_Server.clsDrivers
Dim rsRec As New ADODB.Recordset
Dim itmRec As ListItem

lvDrivers.ListItems.Clear

Set rsRec = objMpool.Select_Driver
If rsRec.EOF And rsRec.BOF Then
   Set rsRec = Nothing
   Set objMpool = Nothing
   MsgBox "No driver records found.", vbInformation, progname
   Exit Sub
End If

rsRec.MoveFirst
While Not rsRec.EOF
   Set itmRec = lvDrivers.ListItems.Add _
      (, , rsRec("Driver_ID"))
   itmRec.SubItems(1) = rsRec("Last_Name")
   itmRec.SubItems(2) = rsRec("First_Name")
   rsRec.MoveNext
Wend

Set rsRec = Nothing
Set objMpool = Nothing
End Sub

Private Sub getDriver()
Dim objMpool As New MPool_Server.clsDrivers
Dim rsRec As New ADODB.Recordset

Set rsRec = objMpool.Select_Driver(lvDrivers.SelectedItem.Text )
If rsRec.EOF And rsRec.BOF Then
   Set rsRec = Nothing
   Set objMpool = Nothing
   MsgBox "Selected driver record not found.", vbInformation, progname
   Exit Sub
End If

txtDriverID.Text = rsRec("Driver_ID")
txtLastName.Text = rsRec("Last_Name")
txtFirstName.Text = rsRec("First_Name")
txtLicNum.Text = rsRec("License_No")
txtLicExpiry.Text = Format(rsRec("Expiry_Date"), "Short Date")

Set rsRec = Nothing
Set objMpool = Nothing

showPic

cmdAdd.Enabled = False
cmdEdit.Enabled = True
cmdDelete.Enabled = True
cmdExit.Enabled = True
cmdOK.Enabled = False
cmdCancel.Enabled = False
End Sub

Private Sub txtLicExpiry_GotFocus()
If IsDate(txtLicExpiry.Text) Then
   txtLicExpiry.Text = Format(CDate(txtLicExpiry.Text), "Short Date")
End If
hiLite
End Sub

Private Sub txtLicExpiry_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
   SendKeys "{TAB}"
   KeyAscii = 0
End If
End Sub

Private Sub txtLicExpiry_LostFocus()
If IsDate(txtLicExpiry.Text) Then
   txtLicExpiry.Text = Format(CDate(txtLicExpiry.Text), "Short Date")
End If
End Sub

Private Sub txtLicNum_GotFocus()
hiLite
End Sub

Private Sub txtLicNum_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
   SendKeys "{TAB}"
   KeyAscii = 0
End If
End Sub

Private Sub showPic()
Dim objFS As New FileSystemObject
Dim strFile As String
Dim strPath As String

strFile = App.Path & "\DriverPics\" & Trim(txtDriverID.Text) & ".JPG"

If objFS.FileExists(strFile) Then
   imgDriverPic.Picture = LoadPicture(strFile)
   lblDriverPic.Caption = "Driver's Picture"
Else
   imgDriverPic.Picture = LoadPicture(App.Path & "\DriverPics\NoPic.JPG")
   lblDriverPic.Caption = "No Picture"
End If
End Sub

Go through the code, you will see how the task is done.

If yuu are not familiar with the 3-tier approach, let me know. I'll try to help.

JFe'







Similar Threads
Thread Thread Starter Forum Replies Last Post
Can't See/Edit GUI After Save and Closing Project? highflight1985 General .NET 2 January 25th, 2007 05:33 PM
image edit save very urgent sakthi VB How-To 1 September 19th, 2006 04:52 PM
Edit/Add/Delete within a DataGrid ozzy VB.NET 2002/2003 Basics 5 January 23rd, 2005 01:17 AM
Edit or Delete records tsimsha Classic ASP Basics 6 October 30th, 2004 03:26 AM
Edit/Delete ButtonColumn not working planoie ASP.NET 1.0 and 1.1 Professional 9 August 30th, 2004 07:39 AM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.