28 January 2016


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.Connection
Dim 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 With
Set 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 data
If 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.


2 comments:

hijram mahjura said...

aetelah saya obrak abrik dg project saya, terjadi maslah pd cmdsave jika ...enable=false " simpan data baru, jika ...enable=true " syntax error missing bla bla bla...
sedikit beda pakai system kode otomatis

Private Sub cmdSave_Click()
On Error GoTo errHandler

'Validasi input data
If Text1.Text = "" Then MsgBox "Kode belum diisi": Exit Sub
If Text2.Text = "" Then MsgBox "Nama belum diisi": Exit Sub
If Text3.Text = "" Then MsgBox "hp belum diisi": Exit Sub
If Text4.Text = "" Then MsgBox "pln belum diisi": Exit Sub
If Text5.Text = "" Then MsgBox "pdam belum diisi": Exit Sub
If Text6.Text = "" Then MsgBox "token belum diisi": Exit Sub

If Text1.Enabled = True Then
'query insert ke database
RunQuery "INSERT INTO tbpelanggan " & _
"(kode,nama,hp,pln,pdam,token) VALUES " & _
"('" & Text1.Text & "', " & _
"'" & Text2.Text & "'," & _
"'" & Text3.Text & "'," & _
"'" & Text4.Text & "'," & _
"'" & Text5.Text & "'," & _
"'" & Text6.Text & "')"

'pesan konfirmasi input berhasil
MsgBox "Data baru telah ditambahkan", vbInformation, "admin"
Else
'query update ke database
RunQuery " UPDATE tbpelanggan SET " & _
" nama = ' " & Text2.Text & " ' " & _
" hp = ' " & Text3.Text & " '" & _
" pln = ' " & Text4.Text & " '" & _
" pdam = ' " & Text5.Text & " '" & _
" token = ' " & Text6.Text & " '" & _
" WHERE kode = ' " & Text1.Text & " ' "


MsgBox "Perubahan data telah tersimpan", vbInformation, "admin"
End If


Cmdclear_Click

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

hijram mahjura said...

bu guru, tolong tambah code agar tidak terjadi double data dia artikel ini, trims