KONEKSI ADODB dengan Ms. Acces 2003 (Form View)

Contoh Studi Kasus--> Pengolahan Data Master Konsumen

Step I :
Buat Database menggunakan MS. Acces dengan struktrur sebagai berikut :
Nama database = konsumen.mdb
Nama table = konsumen

No Field name Type Size
1 kd_pelanggan text 5
2 nm_pelangan text 65
3 Kota text 40
4 Telp text 20

Step II
Desain Sebuah dan konekkanlah dengan Form_menu utama denagn desain form sbb Form dengan sebagai berikut :



Properties frm_konsumen

No Object Properties Value
1 Form Name Frm_konsumen
Startupposition 2. CenterScreen
2 CommodButton Name Cmdnew
Caption Addnew
3 CommodButton Name Cmdedit
Caption Edit
4 CommodButton Name Cmdrefresh
Caption Refresh
5 CommodButton Name Cmdexit
Caption Exit
6 TextBox Name Txtnama
7 Label1 Caption Cari Menurut Nama
8 DataGrid Name DataGrid1

Step III :
Ketikkan KOde Programnya sebagai berikut :

Public cn As ADODB.Connection
Public rs As ADODB.Recordset
Private Sub cmd_exit_Click()
Unload Me
End Sub
Private Sub Form_Load()
Set cn = New ADODB.Connection
cn.Provider = "microsoft.jet.oledb.4.0"
cn.CursorLocation = adUseClient
cn.Open App.Path & "\konsumen.mdb"
Set rs = New ADODB.Recordset
rs.Open "select * from konsumen order by kd_pelanggan", cn, adOpenDynamic, adLockOptimistic
Set DataGrid1.DataSource = rs
Call Dg
cmd_refresh_Click
End Sub
Sub Dg()
DataGrid1.Columns(0).Caption = "Kode"
DataGrid1.Columns(0).Width = 1000
DataGrid1.Columns(1).Caption = "Nama"
DataGrid1.Columns(1).Width = 3000
DataGrid1.Columns(2).Caption = "Telp."
DataGrid1.Columns(2).Width = 1600
DataGrid1.Columns(3).Caption = "Kota"
DataGrid1.Columns(3).Width = 2000
End Sub
Private Sub txtnama_Change()
On Error Resume Next
Set rs = New ADODB.Recordset
rs.Open "select * from konsumen where nama_pelangan like '%" & Trim(txtnama.Text) & "%' order by kd_pelanggan", cn, adOpenDynamic, adLockOptimistic
Set DataGrid1.DataSource = rs
Call Dg
End Sub
Private Sub cmd_refresh_Click()
On Error Resume Next
Set rs = New ADODB.Recordset
rs.Open "select * from konsumen ", cn, adOpenDynamic, adLockOptimistic
Set DataGrid1.DataSource = rs
Call Dg
End Sub
Private Sub cmdnew_Click()
frmmskonsumen.Show
frmmskonsumen.txtkd_pelanggan.Enabled = True
frmmskonsumen.txtkd_pelanggan.SetFocus
frmmskonsumen.txtkd_pelanggan.Text = ""
frmmskonsumen.txtnama_pelanggan.Text = ""
frmmskonsumen.txtalamat.Text = ""
frmmskonsumen.txttelepon.Text = ""
Me.Hide
End Sub
Private Sub cmdedit_Click()
On Error Resume Next
Set rs = New ADODB.Recordset
rs.Open "select * from konsumen ", cn, adOpenDynamic, adLockOptimistic
If rs.RecordCount = 0 Then
MsgBox "Maaf, Database masih kosong", vbInformation, "PERINGATAN"
Else
frmmskonsumen.txtkd_pelanggan.Enabled = False
frmmskonsumen.Show
frmmskonsumen.txtkd_pelanggan.Text = Trim(DataGrid1.Columns(0).Text)
End If
Me.Hide
End Sub
Private Sub Datagrid1_DblClick()
cmdedit_Click
End Sub
Private Sub Form_Activate()
cmd_refresh_Click
cmd_refresh_Click
cmdnew.SetFocus
End Sub

Step IV
Buat Form Ms unttuk fasilitas input sbb :



Properties Form
No Objeck Properties Value
1 Form Name Frmmskonsumen
Stratupposition 2. CenterScreen
2 Label Caption Kode Pelanggan
3 Label Caption Nama Pelanggan
4 Label Caption Alamat
5 Label Caption Telepon
6 Textboxt Name txtkd_pelanggan
7 Textboxt Name Txtnm_pelangan
8 Textboxt Name txtalamat
9 Textboxt Name txtaelepon
10 CommandButton Name CmdSimpan
Caption Simpan
11 CommandButton Name CmdHapus
Caption Hapus
12 CommandButton Name cmdTutup
Caption Tutup

Step V
Ketik Kode Programnya Sbb :

Public cn As ADODB.Connection
Public rs As ADODB.Recordset
Private Sub cmdTutup_Click()
Me.Hide
frm_konsumen.Show
End Sub
Private Sub Form_Load()
Set cn = New ADODB.Connection
cn.Provider = "microsoft.jet.oledb.4.0"
cn.CursorLocation = adUseClient
cn.Open App.Path & "\konsumen.mdb"
Set rs = New ADODB.Recordset
rs.Open "select * from konsumen ", cn, adOpenDynamic, adLockOptimistic
End Sub
Private Sub Form_Activate()
Set rs = New ADODB.Recordset
rs.Open "select * from konsumen where kd_pelanggan ='" & Trim(txtkd_pelanggan.Text) & "'", cn, adOpenDynamic, adLockOptimistic
If rs.RecordCount = 0 Then
Call kosong
SendKeys "{Home}+{End}"
Else
Call Tampil
SendKeys "{Home}+{End}"
End If
End Sub
Private Sub kosong()
txtnama_pelanggan.Text = ""
txtalamat.Text = ""
txttelepon.Text = ""
End Sub
Sub Tampil()
On Error Resume Next
txtnama_pelanggan.Text = rs("nama_pelangan")
txtalamat.Text = rs("kota")
txttelepon.Text = rs("telp")
End Sub
Private Sub cmdSimpan_Click()
On Error Resume Next
Set rs = New ADODB.Recordset
rs.Open "select * from konsumen where kd_pelanggan ='" & Trim(txtkd_pelanggan.Text) & "'", cn, adOpenDynamic, adLockOptimistic
If rs.RecordCount = 0 Then
rs.AddNew
rs("kd_pelanggan") = Trim(txtkd_pelanggan.Text)
rs("nama_pelangan") = Trim(txtnama_pelanggan.Text)
rs("kota") = Trim(txtalamat.Text)
rs("telp") = Trim(txttelepon.Text)
rs.Update
Else
rs("nama_pelangan") = Trim(txtnama_pelanggan.Text)
rs("kota") = Trim(txtalamat.Text)
rs("telp") = Trim(txttelepon.Text)
rs.Update
End If
MsgBox "Proses Simpan Telah Selesai", vbInformation, "PERINGATAN"
cmdTutup_Click
End Sub
Private Sub cmdHapus_Click()
If txtkd_pelanggan.Text = "" Or txtnama_pelanggan.Text = "" Then
MsgBox "Maaf, Ada Field Yang Masih Kosong", vbInformation, "PERINGATAN"
Exit Sub
End If
X = MsgBox("Yakin Akan Menghapus Data Ini", vbYesNo, "HAPUS DATA")
If X = vbYes Then
Set rs = New ADODB.Recordset
rs.Open "Delete * from konsumen where kd_pelanggan ='" & Trim(txtkd_pelanggan.Text) & "'", cn, adOpenDynamic, adLockOptimistic
Call kosong
cmdTutup_Click
End If
End Sub
'---------------------> Source Program Variasi
Private Sub txtkd_pelanggan_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
SendKeys "{Tab}"
txtnama_pelanggan.SetFocus
End If
End Sub
Private Sub txtnama_pelanggan_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
SendKeys "{Tab}"
txtalamat.SetFocus
End If
End Sub
Private Sub txtalamat_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
SendKeys "{Tab}"
txttelepon.SetFocus
End If
End Sub
Private Sub txttelepon_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
cmdSimpan.SetFocus
End If
End Sub