Untuk mengetahui postingan ini silahkan membaca mulai dari permulaan, koneksi visual basic 6 dengan database Ms. Access.
UI:
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
'bila 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 sudah disertakan"
Else
'query update ke database
RunQuery "UPDATE category SET " & _
"categoryname = '" & txtName.Text & "' " & _
"WHERE categorycode = '" & txtCode.Text & "'"
'pesan konfirmasi update sukses
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.
Sumber http://rani-irsan.blogspot.com
EmoticonEmoticon