Back-end dan Front-end Database Access dengan Recordset DAO

Pengertian Back-end dan Front-end Database Access dengan Recordset DAO di sini adalah menggunakan metode yang telah disediakan oleh Access VBA untuk melakukan penambaham, pengeditan, dan penghapusan record melalui DAO.Recordset (DAO=Data Access Object)

Ada banyak sekali metode yang disediakan oleh Access VBA. Namun demikian, kita hanya membahas empat metode yang digunakan untuk penanganan record. Metode itu adalah:

1. Recordset.AddNew: metode untuk membuat dan menambah record baru dalam sebuah objek recordset. Metode ini memberi nilai field dalam tabel yang dinyatakan dengan recordset. Nilai field itu diisi sesuai dengan tipe field. Bila field tidak ada nilainya, maka field itu sama dengan Null. 
2. Recordset.Edit: metode untuk mengedit object recordset yang sudah tersimpan dalam tabel. Metode ini mengganti nilai yang sudah ada di field dalam tabel yang dinyatakan dengan recordset.
3. Recordset.Update: metode untuk menyimpan object recorset yang dibuat baru melalui Recordset.AddNew ke dalam tabel atau diedit melalui Recordset.Edit dan disimpan kembali ke tabel. Tanpa metode ini, kita tidak bisa menyimpan sebuah record ke dalam tabel.
4. Recordset.Delete: metode untuk menghapus object recordset yang tersimpan dalam tabel. Record yang sudah dihapus dikembalikan seperti semula.

Berikut ini adalah contoh penerapan Back-end dan Front-end Database Access dengan Recordset DAO.

1. Gunakan file Access Database_be.accdb yang ada di posting Contoh Sederhana Aplikasi Back-End dan Front-End Database di MS Access Dengan Menggunakan DAO. File Database_be.accdb ini berfungsi sebagai back-end database.
2. Buatlah file database Access dengan nama Database1_fe.accdb. File Database1_fe.accdb ini berfungsi sebagai front-end database.
3. Karena ingin mengambil properti field yang ada di tabel, maka kita harus membuat link table ke Database_be.accdb agar properti tabel di database itu bisa diaplikasikan di mana pun kita ingin membuat object selain table (misalnya, form dan report). Untuk itu, buatlah link table dari satu tabel, misalnya: tabel tblRekDerivatif1, atau seluruh tabel yang ada di file Database_be.accdb. Ikuti cara membuat link table pada link posting tersebut di atas.
4. Setelah link table berhasil dibuat, kita akan membuat form kasar dari link table yang tersedia itu. Misalnya pilih tabel tblRekDerivatif1 seperti di atas. Sorotlah tabel tblRekDerivatif1, lalu buatlah sebuah form sederhana dengan menggunakan cara Membuat Form Menggunakan Form Wizard. Namailah form yang baru dibuat itu: frmRekDerivatif1. 
5. Bukalah frmRekDerivatif1 dalam format Design View, seperti telihat di gambar bawah.
   
6. Atur properti form Navigation Buttons=No, dan Record Selectors=No
7. Kosongkanlah properti Record Source dari form frmRekDerivatif1 (unbound record source)
8. Kosongkanlah Control Source dari form control yang ada di dalam form frmRekDerivatif1 (unbound control source). Hal yang perlu diperhatikan di sini adalah: nama control source harus sama dengan nama field tabel yang ada di tblRekDerivatif1. Ini penting, karena akan digunakan dalam proses retrieving data yang sesuai dengan nama field tabel. Jadi, jangan mengubah nama control source yang menunjukkan nama field tabel.
9. Tampilan frmRekDerivatif1, dalam format Form View akan seperti gambar di bawah.
   
   
   
10. Kini, form yang kosong (unbound) dengan sebagian properti yang berasal dari tabel tblRekDerivatif1 sudah terpasang di form frmRekDerivatif1.
11. Selanjutanya, dengan Design View dari frmRekDerivatif1, sisipkanlah empat buah tombol perintah (command button) dengan properti sbb:
    
    1. Tombol 1: Name=cmdEdit, Caption=&Edit
    2. Tombol 2: Name=cmdSimpan, Caption=&Simpan
    3. Tombol 3: Name=cmdTambah, Caption=&Tambah
    4. Tombol 4: Name=cmdHapus, Caption=&Hapus
    Lihat pada gambar di bawah ini untuk posisi masing-masing tombol perintah.
    
12. Isikanlah kode VBA pada class module Frm_frmRekDerivatif1 seperti di bawah/tab sebelah kanan, setelah itu simpanlah form frmRekDerivatif1.
13.  Pada Access Navigation Pane, hapuslah semua Linked Table yang ada di Object Tables. Tujuannya, untuk memaksimalkan fungsi database fornt-end. Dengan demikian, file Database1_fe.accdb hanya ada satu buah form frmRekDerivatif1, seperti tampak pada gambar di bawah.
    
    
    
14. Bila frmRekDerivatif1dibuka dengan Form View, hasilnya seperti gambar di atas.
    

Kode VBA Yang digunakan

view plainprint?

1. Option Compare Database  
2. Private dbs As DAO.Database  
3. Private Const constNamaTabel As String = "tblRekDerivatif1"  
4. Private strSQL As String, strCriteria As String  
5. Private Enum intPerlakuan  
6.   tampilkanData = 1  
7.   tambahData = 2  
8.   editData = 3  
9. End Enum  
10.   
11. Private Function bukaDatabaseBE()  
12.   Dim strFolderName As String  
13.   Dim strDbsName, strFileName As String  
14.   Dim strProvider As String  
15.   Dim strPassword As String  
16.   Dim strConnection As String  
17.     
18.   Const cnFolderSeparator As String = "\"  
19.   
20. On Error GoTo Err_Msg  
21.   
22. 'Gantilah nilai "D:\SoftwareAkuntansi" yang ada pada variabel strFolderName sesuai dengan lokasi database back-end.  
23.   strFolderName = "D:\SoftwareAkuntansi" & cnFolderSeparator  
24. 'Bila nama file database back-end berbeda, gantilah nilai "Database_be.accdb" yang ada pada variabel strFileName  
25.   strFileName = "Database_be.accdb"  
26.   strProvider = "MS ACCESS"  
27. 'Isikan password bila file database yang ada di strFileName diproteksi dengan password  
28.   strPassword = ""  
29.     
30.   If strPassword <> vbNullString Then strPassword = ";PWD=" & strPassword  
31.     
32.   strConnection = strProvider & strPassword  
33.   strDbsName = strFolderName & strFileName  
34.   Set dbs = OpenDatabase(strDbsName, False, False, strConnection)  
35. Exit_Function:  
36.   Exit Function  
37. Err_Msg:  
38.   MsgBox "Function bukaDatabaseBE, Error # " & Str(Err.Number) & ", source: " & Err.Source & _  
39.   Chr(13) & Err.Description  
40.   Resume Exit_Function  
41. End Function  
42. Private Function tutupDatabaseBE()  
43. On Error GoTo Err_Msg  
44.   dbs.Close  
45.   Set dbs = Nothing  
46. Exit_Function:  
47.   Exit Function  
48. Err_Msg:  
49.   MsgBox "Function tutupDatabaseBE, Error # " & Str(Err.Number) & ", source: " & Err.Source & _  
50.   Chr(13) & Err.Description  
51.   Resume Exit_Function  
52. End Function  
53. Private Function adaKode(strKode As String) As Boolean  
54.   Dim strSqlStat As String  
55.   Dim rs As DAO.Recordset  
56. On Error GoTo Err_Msg  
57.   strSqlStat = "SELECT COUNT(*) FROM " & constNamaTabel & strCriteria ' " WHERE KodeDeriv1='" & strKode & "'"  
58.   Set rs = bukaRecordset(strSqlStat)  
59.   adaKode = False  
60.   If rs.Fields(0).Value > 0 Then adaKode = True  
61.   rs.Close  
62.   Set rs = Nothing  
63. Exit_Function:  
64.   Exit Function  
65. Err_Msg:  
66.   MsgBox "Function adaKode, Error # " & Str(Err.Number) & ", source: " & Err.Source & _  
67.   Chr(13) & Err.Description  
68.   Resume Exit_Function  
69. End Function  
70. Private Function bukaRecordset(strSQL As String, Optional boolForEdit As Boolean) As DAO.Recordset  
71.   Dim rstRecordset As DAO.Recordset  
72. On Error GoTo Err_Msg  
73.   If boolForEdit Then  
74.     Set rstRecordset = dbs.OpenRecordset(strSQL, dbOpenDynaset)  
75.   Else  
76.     Set rstRecordset = dbs.OpenRecordset(strSQL, dbOpenSnapshot)  
77.   End If  
78.   Set bukaRecordset = rstRecordset  
79.     
80. Exit_Function:  
81.   Exit Function  
82. Err_Msg:  
83.   MsgBox "Function bukaRecordset, Error # " & Str(Err.Number) & ", source: " & Err.Source & _  
84.   Chr(13) & Err.Description  
85.   Resume Exit_Function  
86. End Function  
87. Private Function jalankanExecQuery(strSQL As String) 'OK  
88. On Error GoTo Err_Msg  
89.   dbs.Execute strSQL, dbFailOnError  
90. Exit_Function:  
91.   Exit Function  
92. Err_Msg:  
93.   MsgBox "Function jalankanExecQuery, Error # " & Str(Err.Number) & ", source: " & Err.Source & _  
94.   Chr(13) & Err.Description  
95.   Resume Exit_Function  
96. End Function  
97. Private Function lakukanQuery(intJenisPerlakuan As intPerlakuan)  
98.   Dim rs As DAO.Recordset  
99.   Dim fld As Field  
100.   Dim ctl As Control  
101.   Dim strSqlStat As String  
102.     
103. On Error GoTo Err_Msg  
104.   strSqlStat = strSQL & strCriteria  
105.   Set rs = bukaRecordset(strSqlStat, True)  
106.   If intJenisPerlakuan = tampilkanData Then  
107.     For Each ctl In Me  
108.       For Each fld In rs.Fields  
109.         If ctl.Name = fld.Name Then Controls(ctl.Name).Value = fld.Value  
110.       Next fld  
111.     Next ctl  
112.   Else  
113.     If intJenisPerlakuan = tambahData Then rs.AddNew  
114.     If intJenisPerlakuan = editData Then  
115.       If Not bisaDiUpdate(strSqlStat) Then Exit Function Else rs.Edit  
116.     End If  
117.     For Each fld In rs.Fields  
118.       For Each ctl In Me  
119.         If fld.Name = ctl.Name Then fld.Value = Controls(ctl.Name).Value  
120.       Next ctl  
121.     Next fld  
122.     rs.Update  
123.   End If  
124.   rs.Close  
125.   Set rs = Nothing  
126. Exit_Function:  
127.   Exit Function  
128. Err_Msg:  
129.   MsgBox "Function lakukanQuery, Error # " & Str(Err.Number) & ", source: " & Err.Source & _  
130.   Chr(13) & Err.Description  
131.   Resume Exit_Function  
132. End Function  
133. Function bisaDiUpdate(strSQL As String) As Boolean  
134.   
135. Dim rs As DAO.Recordset  
136. Dim intPosition As Integer  
137.   
138. On Error GoTo Err_Msg  
139.   
140.    bisaDiUpdate = True  
141.   
142.    Set rs = bukaRecordset(strSQL, True)  
143.   
144.    If rs.Updatable = False Then  
145.       bisaDiUpdate = False  
146.    Else  
147.       For intPosition = 0 To rs.Fields.Count - 1  
148.          If rs.Fields(intPosition).DataUpdatable = False Then  
149.             bisaDiUpdate = False  
150.             Exit For  
151.          End If  
152.       Next intPosition  
153.    End If  
154.   
155.    rs.Close  
156.    Set rs = Nothing  
157.      
158. Exit_Function:  
159.   Exit Function  
160. Err_Msg:  
161.   MsgBox "Function bisaDiUpdate, Error # " & Str(Err.Number) & ", source: " & Err.Source & _  
162.   Chr(13) & Err.Description  
163.   Resume Exit_Function  
164. End Function  
165.   
166. Private Sub cmdEdit_Click()  
167.   strCriteria = " WHERE KodeDeriv1='" & Me.KodeDeriv1 & "'"  
168.   If adaKode(Me.KodeDeriv1) Then  
169.     lakukanQuery tampilkanData  
170.   Else  
171.     Me.NamaDeriv1 = vbNullString  
172.     Me.Catatan = vbNullString  
173.     Me.NamaDeriv1.SetFocus  
174.   End If  
175. End Sub  
176.   
177. Private Sub cmdHapus_Click()  
178.   Dim rs As DAO.Recordset  
179.   Dim strSqlStat As String  
180.   If adaKode(Me.KodeDeriv1) Then  
181.     strSqlStat = strSQL & strCriteria  
182.     If MsgBox("Kode rekening " & Me.KodeDeriv1 & " akan dihapus?", vbYesNo) = vbYes Then  
183.       Set rs = bukaRecordset(strSqlStat, True)  
184.       rs.Delete  
185.       cmdTambah_Click  
186.       Me.KodeDeriv1.SetFocus  
187.       rs.Close  
188.       Set rs = Nothing  
189.     Else  
190.       Cancel = True  
191.       Exit Sub  
192.     End If  
193.   Else  
194.     MsgBox "Kode rekening " & Me.KodeDeriv1 & " tidak ada dalam tabel"  
195.   End If  
196. End Sub  
197.   
198. Private Sub cmdSimpan_Click()  
199.   Dim strSqlStat As String  
200.   
201.   If adaKode(Me.KodeDeriv1) Then  
202.     lakukanQuery editData  
203.   Else  
204.     lakukanQuery tambahData  
205.   End If  
206. End Sub  
207.   
208. Private Sub cmdTambah_Click()  
209.   Me.KodeDeriv1 = vbNullString  
210.   Me.NamaDeriv1 = vbNullString  
211.   Me.Catatan = vbNullString  
212. End Sub  
213.   
214. Private Sub Form_Open(Cancel As Integer)  
215.   bukaDatabaseBE  
216.   strSQL = "SELECT * FROM " & constNamaTabel  
217. End Sub  
218.   
219. Private Sub KodeDeriv1_AfterUpdate()  
220.   cmdEdit_Click  
221. End Sub  

Option Compare Database
Private dbs As DAO.Database
Private Const constNamaTabel As String = "tblRekDerivatif1"
Private strSQL As String, strCriteria As String
Private Enum intPerlakuan
  tampilkanData = 1
  tambahData = 2
  editData = 3
End Enum

Private Function bukaDatabaseBE()
  Dim strFolderName As String
  Dim strDbsName, strFileName As String
  Dim strProvider As String
  Dim strPassword As String
  Dim strConnection As String
  
  Const cnFolderSeparator As String = "\"

On Error GoTo Err_Msg

'Gantilah nilai "D:\SoftwareAkuntansi" yang ada pada variabel strFolderName sesuai dengan lokasi database back-end.
  strFolderName = "D:\SoftwareAkuntansi" & cnFolderSeparator
'Bila nama file database back-end berbeda, gantilah nilai "Database_be.accdb" yang ada pada variabel strFileName
  strFileName = "Database_be.accdb"
  strProvider = "MS ACCESS"
'Isikan password bila file database yang ada di strFileName diproteksi dengan password
  strPassword = ""
  
  If strPassword <> vbNullString Then strPassword = ";PWD=" & strPassword
  
  strConnection = strProvider & strPassword
  strDbsName = strFolderName & strFileName
  Set dbs = OpenDatabase(strDbsName, False, False, strConnection)
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Function bukaDatabaseBE, Error # " & Str(Err.Number) & ", source: " & Err.Source & _
  Chr(13) & Err.Description
  Resume Exit_Function
End Function
Private Function tutupDatabaseBE()
On Error GoTo Err_Msg
  dbs.Close
  Set dbs = Nothing
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Function tutupDatabaseBE, Error # " & Str(Err.Number) & ", source: " & Err.Source & _
  Chr(13) & Err.Description
  Resume Exit_Function
End Function
Private Function adaKode(strKode As String) As Boolean
  Dim strSqlStat As String
  Dim rs As DAO.Recordset
On Error GoTo Err_Msg
  strSqlStat = "SELECT COUNT(*) FROM " & constNamaTabel & strCriteria ' " WHERE KodeDeriv1='" & strKode & "'"
  Set rs = bukaRecordset(strSqlStat)
  adaKode = False
  If rs.Fields(0).Value > 0 Then adaKode = True
  rs.Close
  Set rs = Nothing
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Function adaKode, Error # " & Str(Err.Number) & ", source: " & Err.Source & _
  Chr(13) & Err.Description
  Resume Exit_Function
End Function
Private Function bukaRecordset(strSQL As String, Optional boolForEdit As Boolean) As DAO.Recordset
  Dim rstRecordset As DAO.Recordset
On Error GoTo Err_Msg
  If boolForEdit Then
    Set rstRecordset = dbs.OpenRecordset(strSQL, dbOpenDynaset)
  Else
    Set rstRecordset = dbs.OpenRecordset(strSQL, dbOpenSnapshot)
  End If
  Set bukaRecordset = rstRecordset
  
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Function bukaRecordset, Error # " & Str(Err.Number) & ", source: " & Err.Source & _
  Chr(13) & Err.Description
  Resume Exit_Function
End Function
Private Function jalankanExecQuery(strSQL As String) 'OK
On Error GoTo Err_Msg
  dbs.Execute strSQL, dbFailOnError
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Function jalankanExecQuery, Error # " & Str(Err.Number) & ", source: " & Err.Source & _
  Chr(13) & Err.Description
  Resume Exit_Function
End Function
Private Function lakukanQuery(intJenisPerlakuan As intPerlakuan)
  Dim rs As DAO.Recordset
  Dim fld As Field
  Dim ctl As Control
  Dim strSqlStat As String
  
On Error GoTo Err_Msg
  strSqlStat = strSQL & strCriteria
  Set rs = bukaRecordset(strSqlStat, True)
  If intJenisPerlakuan = tampilkanData Then
    For Each ctl In Me
      For Each fld In rs.Fields
        If ctl.Name = fld.Name Then Controls(ctl.Name).Value = fld.Value
      Next fld
    Next ctl
  Else
    If intJenisPerlakuan = tambahData Then rs.AddNew
    If intJenisPerlakuan = editData Then
      If Not bisaDiUpdate(strSqlStat) Then Exit Function Else rs.Edit
    End If
    For Each fld In rs.Fields
      For Each ctl In Me
        If fld.Name = ctl.Name Then fld.Value = Controls(ctl.Name).Value
      Next ctl
    Next fld
    rs.Update
  End If
  rs.Close
  Set rs = Nothing
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Function lakukanQuery, Error # " & Str(Err.Number) & ", source: " & Err.Source & _
  Chr(13) & Err.Description
  Resume Exit_Function
End Function
Function bisaDiUpdate(strSQL As String) As Boolean

Dim rs As DAO.Recordset
Dim intPosition As Integer

On Error GoTo Err_Msg

   bisaDiUpdate = True

   Set rs = bukaRecordset(strSQL, True)

   If rs.Updatable = False Then
      bisaDiUpdate = False
   Else
      For intPosition = 0 To rs.Fields.Count - 1
         If rs.Fields(intPosition).DataUpdatable = False Then
            bisaDiUpdate = False
            Exit For
         End If
      Next intPosition
   End If

   rs.Close
   Set rs = Nothing
   
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Function bisaDiUpdate, Error # " & Str(Err.Number) & ", source: " & Err.Source & _
  Chr(13) & Err.Description
  Resume Exit_Function
End Function

Private Sub cmdEdit_Click()
  strCriteria = " WHERE KodeDeriv1='" & Me.KodeDeriv1 & "'"
  If adaKode(Me.KodeDeriv1) Then
    lakukanQuery tampilkanData
  Else
    Me.NamaDeriv1 = vbNullString
    Me.Catatan = vbNullString
    Me.NamaDeriv1.SetFocus
  End If
End Sub

Private Sub cmdHapus_Click()
  Dim rs As DAO.Recordset
  Dim strSqlStat As String
  If adaKode(Me.KodeDeriv1) Then
    strSqlStat = strSQL & strCriteria
    If MsgBox("Kode rekening " & Me.KodeDeriv1 & " akan dihapus?", vbYesNo) = vbYes Then
      Set rs = bukaRecordset(strSqlStat, True)
      rs.Delete
      cmdTambah_Click
      Me.KodeDeriv1.SetFocus
      rs.Close
      Set rs = Nothing
    Else
      Cancel = True
      Exit Sub
    End If
  Else
    MsgBox "Kode rekening " & Me.KodeDeriv1 & " tidak ada dalam tabel"
  End If
End Sub

Private Sub cmdSimpan_Click()
  Dim strSqlStat As String

  If adaKode(Me.KodeDeriv1) Then
    lakukanQuery editData
  Else
    lakukanQuery tambahData
  End If
End Sub

Private Sub cmdTambah_Click()
  Me.KodeDeriv1 = vbNullString
  Me.NamaDeriv1 = vbNullString
  Me.Catatan = vbNullString
End Sub

Private Sub Form_Open(Cancel As Integer)
  bukaDatabaseBE
  strSQL = "SELECT * FROM " & constNamaTabel
End Sub

Private Sub KodeDeriv1_AfterUpdate()
  cmdEdit_Click
End Sub

Pembaca dapat memperoleh sample file database back-end dan front-end dengan cara sbb:

1. Ikuti blog Access Terapan di Facebook dengan mem-follow atau me-like FB page di https://www.facebook.com/AccessTerapan atau follow Google Blog Follower. Bagi yang tidak memfollow, permintaan (request) akan diabaikan.
2. Kirim email ke admin yanto.e.subroto@gmail.com untuk diikutsertakan menjadi anggota grup Access Terapan. 
3. Sebagai tanda bukti keanggotaan, admin grup Access Terapan akan mengirimkan email ke alamat yang dituju. 
4. Selanjutnya, silakan download dua file zip berikut ini:
   1. Database_be.zip yang merupakan Access Database back-end (nama file Database_be.accdb), dapat diinstall di server, PC desktop, dsb.
   2. Database1_fe.zip yang merupakan Access Database front-end (nama file Database1_be.accdb), dapat diinstall di client, PC desktop, dsb.
5. Ikuti perintah yang ada dalam kode VBA di atas, pada baris komentar 'Gantilah nilai "D:\SoftwareAkuntansi" yang ada pada variabel strFolderName sesuai dengan lokasi database back-end.
6. Bukalah form frmRekDerivatif1 dalam format Form View.
7. Sebagai uji coba isikan salah satu item seperti contoh gambar terakhir di atas, lalu klik tombol Edit.