VB6 Ms Access: Pengolahan Data (CRUD), Code Selengkapnya

Untuk memahami artikel ini silahkan membaca mulai dari awal, koneksi visual basic 6 dengan database Ms. Access.

UI:

Code:
Option Explicit
Dim oConn As New ADODB.ConnectionDim rsData As New ADODB.RecordsetDim strConn As StringDim SQL As String

Sub Open_Connection()Set oConn = New ADODB.Connection
oConn.ConnectionString = strConn
oConn.Open
End Sub
Sub Load_Data(Optional strFilter As String)
On Error GoTo errHandler

Open_Connection
Set rsData = New ADODB.Recordset
SQL = "SELECT * FROM Category " & strFilter
With rsData
    .CursorLocation = adUseClient
    .Open SQL, oConn, adOpenDynamic, adLockOptimistic
    .ActiveConnection = Nothing
End WithSet grdData.DataSource = rsData
oConn.Close

Exit Sub
errHandler:
MsgBox Err.Number & ":" & Err.Description
End Sub

Private Sub Form_Load()
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
          "Data Source=" & App.Path & "\latihan.mdb;" & _
          "Persist Security Info=False"
Load_Data
End Sub

Private Sub cmdFilter_Click()
Load_Data "WHERE CategoryCode LIKE '%" & txtFilter.Text & "%' " & _
          "OR CategoryName LIKE '%" & txtFilter.Text & "%' "
End Sub

Sub RunQuery(sSQL As String)
Dim cmd As New ADODB.Command
Set cmd = New ADODB.Command
With cmd
    .ActiveConnection = strConn
    .CommandType = adCmdText
    .CommandText = sSQL
    .Execute
End With
Set cmd = Nothing
End Sub

Private Sub grdData_DblClick()
On Error GoTo errHandler

'jika di grid tidak ada data
If rsData.RecordCount = 0 Then Exit Sub

With Me
    .txtCode.Text = rsData!categorycode
    .txtName.Text = rsData!categoryname
    .txtCode.Enabled = False
End With

Exit Sub
errHandler:
MsgBox Err.Number & ":" & Err.Description
End Sub

Private Sub cmdEdit_Click()
grdData_DblClick
End Sub

Private Sub cmdSave_Click()
On Error GoTo errHandler

'Validasi input dataIf txtCode.Text = "" Then MsgBox "Kode belum diisi": Exit SubIf txtName.Text = "" Then MsgBox "Nama belum diisi": Exit Sub
If txtCode.Enabled = True Then
    'query insert ke database
    RunQuery "INSERT INTO category " & _
             "(categorycode, categoryname) VALUES " & _
             "('" & txtCode.Text & "', " & _
             "'" & txtName.Text & "')"
            
    'pesan konfirmasi input berhasil
    MsgBox "Data baru telah ditambahkan"
Else
    'query update ke database
    RunQuery "UPDATE category SET " & _
             "categoryname = '" & txtName.Text & "' " & _
             "WHERE categorycode = '" & txtCode.Text & "'"
            
    'pesan konfirmasi update berhasil
    MsgBox "Perubahan data telah tersimpan"
End If

'membersihkan control input
cmdCancel_Click

Exit Sub
errHandler:
MsgBox Err.Number & ":" & Err.Description
End Sub

Private Sub cmdDelete_Click()
On Error GoTo errHandler

'jika data kosong code pada event ini tidak akan dijalankan
If rsData.RecordCount = 0 Then Exit Sub

'konfirmasi penghapusan
If MsgBox("Yakin akan menghapus kategori " & _
          rsData!categorycode & "?", vbOKCancel) = vbOK Then
   RunQuery "DELETE FROM category WHERE " & _
            "categorycode = '" & rsData!categorycode & "'"
   MsgBox "Data Terhapus"
End If

'membersihkan control input
cmdCancel_Click

Exit Sub
errHandler:
MsgBox Err.Number & ":" & Err.Description
End Sub

Private Sub cmdCancel_Click()
Load_Data
txtCode.Enabled = True
txtCode.Text = ""
txtName.Text = ""
End Sub

Private Sub cmdExit_Click()
Unload Me
End Sub


Click here if you like this article.