Contoh Sederhana Aplikasi Back-End dan Front-End Database di MS Access Dengan Menggunakan DAO

Seperti kita tahu, MS Access merupakan aplikasi database (DBMS) yang sangat user-friendly. Kemudahan Access bisa dilihat dari berbagai macam feature yang tersedia dan bisa dipelajari oleh seorang pemula, bahkan yang masih awam dengan database. Di satu sisi, bagi programmer tingkat lanjut, kita bisa juga membuat program yang lebih canggih yang bagi sebagian awam mungkin nampak simple tetapi perlu kreativitas yang memadai.

Pada posting kali ini, kita akan membuat aplikasi database back-end dan front-end di MS Access dengan menggunakan Data Access Object (DAO) library. Ikuti langkah-langkahnya sebagai berikut:

1. Buatlah database yang hanya berisi tabel (dan query, jika diperlukan). Sebagai contoh, database akuntansi yang hanya berisi tabel seperti yang dijelaskan di posting Daftar Isi, Membuat Tabel yang Diperlukan. Database itu dapat dilihat pada gambar di bawah. Namailah database itu: Database_be.accdb

2. Bila sudah selesai membuat database back-end, selanjutnya, kita akan membuat database front-end. Untuk itu, tutuplah file Database_be.accdb lalu buatlah file database Access dengan nama Database_fe.accdb.
3. Karena ingin mengambil properti field yang ada di tabel, maka kita harus membuat link database agar properti tabel 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 tblRekUtama, atau seluruh tabel yang ada di file Database_be.accdb. Cara membuat link table:
   1. Klik External Data > Import > Access, maka akan muncul kotak dialog Get Externel Data - Access Database.
   2. Pada bagian text box File name, isikan nama lokasi folder beserta file yang bernama Database_be.accdb. Lalu pilih Link to the data source by creating a linked table. Lihat gambar di bawah. Klik OK.
      
      
   3. Kotak dialog Link Tables selanjutnya akan ditampilkan, seperti pada gamber di bawah. Kita bisa memilih satu tabel atau semua tabel yang ada di dalam list box. Tekan tombol Select All untuk memilih semua tabel yang ada di list box. Bila sudah yakin, tekan tombol OK untuk mengakhiri.
      
      
   4. Link table sudah dimuat di bagian Tables dari Access Navigation Pane, dengan tanda panah ke kanan. Seperti terlihat di bawah.
      
   5. Dari daftar link table seperti di atas, kita bisa membuat aplikasi front-end seperti yang dibahas di awal.
4. Selanjutnya, kita akan membuat form kasar dari link table yang tersedia itu. Misalnya pilih tabel tblRekUtama seperti di atas.
5. Setelah memilih tabel, lalu buatlah sebuah form sederhana dengan menggunakan cara Membuat Form Menggunakan Form Wizard. Namailah form yang baru dibuat itu: frmRekUtama. 
6. Bukalah frmRekUtama dalam format Design View, seperti telihat di gambar bawah.
   
7. Atur properti form Navigation Buttons=No, dan Record Selectors=No
8. Kosongkanlah properti Record Source dari form frmRekUtama (unbound record source)
9. Kosongkanlah Control Source dari form control yang ada di dalam form frmRekUtama (unbound control source). Hal yang perlu diperhatikan di sini adalah: Nama control source harus sama dengan nama field tabel yang ada di tblRekUtama. 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.
10. Hasil akhir terlihat di gambar bawah:
    
11. Tampilan frmRekUtama, dalam format Form View akan seperti gambar di bawah.
    
12. Kini, form yang kosong (unbound) dengan sebagian properti yang berasal dari tabel tblRekUtama sudah terpasang di form frmRekUtama.
13. Selanjutanya, dengan Design View dari frmRekUtama, 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.
    
    
    
14. Isikanlah kode VBA pada class module Frm_frmRekUtama seperti di bawah/tab sebelah kanan, setelah itu simpanlah form frmRekUtama
15.  Pada Access Navigation Pane, hapuslah semua Linked Table yang ada di Object Tables. Tujuannya, untuk memaksimalkan fungsi database fornt-end. Dengan demikian, file Database_fe.accdb hanya ada satu buah form frmRekUtama, seperti tampak pada gambar di bawah.
    
16. Bila frmRekUtama dibuka dengan Form View, hasilnya seperti gambar di atas.
    

view plainprint?

1. Option Compare Database  
2. Private dbs As DAO.Database  
3. Private Const constNamaTabel As String = "tblRekUtama"  
4. Private strsql As String  
5. Private Function bukaDatabaseBE()  
6.   Dim strFolderName As String  
7.   Dim strDbsName, strFileName As String  
8.   Dim strProvider As String  
9.   Dim strPassword As String  
10.   Dim strConnection As String  
11.     
12.   Const cnFolderSeparator As String = "\"  
13.   
14. On Error GoTo Err_Msg  
15.   
16. 'Gantilah nilai "D:\SoftwareAkuntansi" yang ada pada variabel strFolderName sesuai dengan lokasi database back-end.  
17.   strFolderName = "D:\SoftwareAkuntansi" & cnFolderSeparator  
18. 'Bila nama file database back-end berbeda, gantilah nilai "Database_be.accdb" yang ada pada variabel strFileName  
19.   strFileName = "Database_be.accdb"  
20.   strProvider = "MS ACCESS"  
21. 'Isikan password bila file database yang ada di strFileName diproteksi dengan password  
22.   strPassword = ""  
23.     
24.   If strPassword <> vbNullString Then strPassword = ";PWD=" & strPassword  
25.     
26.   strConnection = strProvider & strPassword  
27.   strDbsName = strFolderName & strFileName  
28.   Set dbs = OpenDatabase(strDbsName, False, False, strConnection)  
29. Exit_Function:  
30.   Exit Function  
31. Err_Msg:  
32.   MsgBox "Function bukaDatabaseBE, Error # " & Str(Err.Number) & ", source: " & Err.Source & _  
33.   Chr(13) & Err.Description  
34.   Resume Exit_Function  
35. End Function  
36. Private Function tutupDatabaseBE()  
37. On Error GoTo Err_Msg  
38.   dbs.Close  
39.   Set dbs = Nothing  
40. Exit_Function:  
41.   Exit Function  
42. Err_Msg:  
43.   MsgBox "Function tutupDatabaseBE, Error # " & Str(Err.Number) & ", source: " & Err.Source & _  
44.   Chr(13) & Err.Description  
45.   Resume Exit_Function  
46. End Function  
47. Private Function adaKode(strKode As String) As Boolean  
48.   Dim strSqlStat As String  
49.   Dim rs As DAO.Recordset  
50. On Error GoTo Err_Msg  
51.   strSqlStat = "SELECT COUNT(*) FROM " & constNamaTabel & " WHERE KodeRek='" & strKode & "'"  
52.   Set rs = bukaRecordset(strSqlStat)  
53.   adaKode = False  
54.   If rs.Fields(0).Value > 0 Then adaKode = True  
55.   rs.Close  
56.   Set rs = Nothing  
57. Exit_Function:  
58.   Exit Function  
59. Err_Msg:  
60.   MsgBox "Function adaKode, Error # " & Str(Err.Number) & ", source: " & Err.Source & _  
61.   Chr(13) & Err.Description  
62.   Resume Exit_Function  
63. End Function  
64. Private Function bukaRecordset(strsql As String, Optional boolForEdit As Boolean) As DAO.Recordset  
65.   Dim rstRecordset As DAO.Recordset  
66. On Error GoTo Err_Msg  
67.   If boolForEdit Then  
68.     Set rstRecordset = dbs.OpenRecordset(strsql, dbOpenDynaset)  
69.   Else  
70.     Set rstRecordset = dbs.OpenRecordset(strsql, dbOpenSnapshot)  
71.   End If  
72.   Set bukaRecordset = rstRecordset  
73.     
74. Exit_Function:  
75.   Exit Function  
76. Err_Msg:  
77.   MsgBox "Function bukaRecordset, Error # " & Str(Err.Number) & ", source: " & Err.Source & _  
78.   Chr(13) & Err.Description  
79.   Resume Exit_Function  
80. End Function  
81. Private Function jalankanExecQuery(strsql As String) 'OK  
82. On Error GoTo Err_Msg  
83.   dbs.Execute strsql, dbFailOnError  
84. Exit_Function:  
85.   Exit Function  
86. Err_Msg:  
87.   MsgBox "Function jalankanExecQuery, Error # " & Str(Err.Number) & ", source: " & Err.Source & _  
88.   Chr(13) & Err.Description  
89.   Resume Exit_Function  
90. End Function  
91. Private Function tampilkanData(strKode As String)  
92.   Dim rs As DAO.Recordset  
93.   Dim fld As Field  
94.   Dim ctl As Control  
95.   Dim strSqlStat As String  
96.     
97. On Error GoTo Err_Msg  
98.   strSqlStat = strsql & " WHERE KodeRek='" & strKode & "'"  
99.   Set rs = bukaRecordset(strSqlStat, True)  
100.     
101.   For Each ctl In Me  
102.     For Each fld In rs.Fields  
103.       If ctl.Name = fld.Name Then Controls(ctl.Name).Value = fld.Value  
104.     Next fld  
105.     
106.   Next ctl  
107.   rs.Close  
108.   Set rs = Nothing  
109. Exit_Function:  
110.   Exit Function  
111. Err_Msg:  
112.   MsgBox "Function tampilkanData, Error # " & Str(Err.Number) & ", source: " & Err.Source & _  
113.   Chr(13) & Err.Description  
114.   Resume Exit_Function  
115. End Function  
116. Private Sub cmdEdit_Click()  
117.   If adaKode(Me.KodeRek) Then  
118.     tampilkanData Me.KodeRek  
119.   Else  
120.     Me.NamaRek = vbNullString  
121.     Me.Grup = vbNullString  
122.     Me.NamaRek.SetFocus  
123.   End If  
124. End Sub  
125.   
126. Private Sub cmdHapus_Click()  
127.   Dim strSqlStat As String  
128.   If adaKode(Me.KodeRek) Then  
129.     strSqlStat = "DELETE * FROM " & constNamaTabel & _  
130.                  " WHERE KodeRek='" & Me.KodeRek & "'"  
131.     If MsgBox("Kode rekening " & Me.KodeRek & " akan dihapus?", vbYesNo) = vbYes Then  
132.       jalankanExecQuery strSqlStat  
133.       cmdTambah_Click  
134.       Me.KodeRek.SetFocus  
135.     Else  
136.       Cancel = True  
137.       Exit Sub  
138.     End If  
139.       
140.     
141.   Else  
142.     MsgBox "Kode rekening " & Me.KodeRek & " tidak ada dalam tabel"  
143.   End If  
144. End Sub  
145.   
146. Private Sub cmdSimpan_Click()  
147.   Dim strSqlStat As String  
148.   
149.   If adaKode(Me.KodeRek) Then  
150.     strSqlStat = "UPDATE " & constNamaTabel & _  
151.                  " SET KodeRek='" & Me.KodeRek & "', NamaRek='" & Me.NamaRek & "', Grup='" & Me.Grup & "'" & _  
152.                  " WHERE KodeRek='" & Me.KodeRek & "'"  
153.   Else  
154.     strSqlStat = "INSERT INTO " & constNamaTabel & "(KodeRek, NamaRek, Grup) " & _  
155.                  " VALUES ('" & Me.KodeRek & "', '" & Me.NamaRek & "', '" & Me.Grup & "')"  
156.   End If  
157.   jalankanExecQuery strSqlStat  
158. End Sub  
159.   
160. Private Sub cmdTambah_Click()  
161.   Me.KodeRek = vbNullString  
162.   Me.NamaRek = vbNullString  
163.   Me.Grup = vbNullString  
164. End Sub  
165.   
166. Private Sub Form_Open(Cancel As Integer)  
167.   bukaDatabaseBE  
168.   strsql = "SELECT * FROM " & constNamaTabel  
169. End Sub  
170.   
171. Private Sub KodeRek_AfterUpdate()  
172.   cmdEdit_Click  
173. End Sub  

Option Compare Database
Private dbs As DAO.Database
Private Const constNamaTabel As String = "tblRekUtama"
Private strsql As String
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 & " WHERE KodeRek='" & 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 tampilkanData(strKode As String)
  Dim rs As DAO.Recordset
  Dim fld As Field
  Dim ctl As Control
  Dim strSqlStat As String
  
On Error GoTo Err_Msg
  strSqlStat = strsql & " WHERE KodeRek='" & strKode & "'"
  Set rs = bukaRecordset(strSqlStat, True)
  
  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
  rs.Close
  Set rs = Nothing
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Function tampilkanData, Error # " & Str(Err.Number) & ", source: " & Err.Source & _
  Chr(13) & Err.Description
  Resume Exit_Function
End Function
Private Sub cmdEdit_Click()
  If adaKode(Me.KodeRek) Then
    tampilkanData Me.KodeRek
  Else
    Me.NamaRek = vbNullString
    Me.Grup = vbNullString
    Me.NamaRek.SetFocus
  End If
End Sub

Private Sub cmdHapus_Click()
  Dim strSqlStat As String
  If adaKode(Me.KodeRek) Then
    strSqlStat = "DELETE * FROM " & constNamaTabel & _
                 " WHERE KodeRek='" & Me.KodeRek & "'"
    If MsgBox("Kode rekening " & Me.KodeRek & " akan dihapus?", vbYesNo) = vbYes Then
      jalankanExecQuery strSqlStat
      cmdTambah_Click
      Me.KodeRek.SetFocus
    Else
      Cancel = True
      Exit Sub
    End If
    
  
  Else
    MsgBox "Kode rekening " & Me.KodeRek & " tidak ada dalam tabel"
  End If
End Sub

Private Sub cmdSimpan_Click()
  Dim strSqlStat As String

  If adaKode(Me.KodeRek) Then
    strSqlStat = "UPDATE " & constNamaTabel & _
                 " SET KodeRek='" & Me.KodeRek & "', NamaRek='" & Me.NamaRek & "', Grup='" & Me.Grup & "'" & _
                 " WHERE KodeRek='" & Me.KodeRek & "'"
  Else
    strSqlStat = "INSERT INTO " & constNamaTabel & "(KodeRek, NamaRek, Grup) " & _
                 " VALUES ('" & Me.KodeRek & "', '" & Me.NamaRek & "', '" & Me.Grup & "')"
  End If
  jalankanExecQuery strSqlStat
End Sub

Private Sub cmdTambah_Click()
  Me.KodeRek = vbNullString
  Me.NamaRek = vbNullString
  Me.Grup = vbNullString
End Sub

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

Private Sub KodeRek_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 buah 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. Database_fe.zip yang merupakan Access Database front-end (nama file Database_fe.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 frmRekUtama dalam format Form View.
7. Sebagai uji coba isikan salah satu item seperti contoh gambar terakhir di atas, lalu klik tombol Edit.