Membaca Data Tipe BLOB di MS Access

Berbeda dengan tipe data lain non BLOB yang bisa langsung terbaca dengan membuka Datasheet view dari sebuah tabel, tipe data BLOB tidak bisa dibaca dengan cara itu. Dengan membuka Datasheet view tabel yang berisi data BLOB, kita hanya akan melihat sebuah tulisan Long Binary Data tanpa mengetahui bagaimana bentuk data yang sebenarnya adalah sebuah file.

Di MS Access, semua data BLOB, bila disimpan ke dalam sebuah tabel hanya ada tulisan Long Binary Data. Kita tidak bisa tahu seperti apakah bentuknya. Sebagai contoh, lihat gambar di bawah ini, Datasheet view tabel tblBlob. Pada tabel itu, terdapat berbagai macam file. Bila kolom non BLOB data seperti blobMeta, blobNamaFile, blobNamaEkstensi, blobUkuran, dan blobDeskripsi dihilangkan, maka kita tidak akan tahu jenis file apa yang ada didalamnya.

Gambar 1. Field/kolom blobData yang berisi data BLOB berupa file

Di sinilah letak pentingnya kolom atau field non-BLOB, seperti yang telah dibuat sebelumnya pada posting yang berjudul Mengenal Tipe Data BLOB di MS Access, yaitu untuk memberikan informasi yang relevan dengan data BLOB itu sendiri. Dengan mengetahui jenis file yang ada dalam field dengan tipe data BLOB, kita bisa memberi semacam perlakuan untuk mengkonversi file sesuai dengan jenisnya, sehingga data BLOB itu bisa terbaca.

Cara membaca data BLOB

Supaya data BLOB bisa terbaca, maka kita harus mentransfer data BLOB menjadi sebuah file. File itu akan disimpan sementara. Bila tidak dipergunakan lagi, kita bisa menghapusnya dengan tujuan untuk menghemat pemakaian media penyimpanan. File sementara itu disimpan di direktori sementara. Tujuannya, selain untuk menjaga kerahasiaan, juga untuk menghemat trafik jaringan. Setelah menjadi file, kita dapat membukanya dengan aplikasi yang sesuai.

Gambar 2. Data BLOB berupa file gambar (atas dan bawah)

Berikut ini adalah cara membaca data BLOB. Sebagai percobaan, kita akan menggunakan form frmBLOB yang telah dibuat sebelumnya di posting yang berjudul Menyimpan Data Tipe BLOB di MS Access.

1. Bukalah Design View dari form frmBlob.
2. Pada bagian Form Header, sisipkanlah text box dan tombol perintah dengan rincian properti sebagai berikut:
   
   1. Text box, Name= txtKriteria
   2. Button (Form Control), Name= cmdTampilkan, Caption= Tampilkan
   3. Button (Form Control), Name= cmdGanti, Caption= Ganti File yang Sudah Ada
3. Pada bagian Form Detail, sisipkan sebuah tombol perintah dengan properti sebagai berikut: Name= cmdBukaFile, Caption= Buka File.
4. Masih pada bagian Form Detail, sorotlah control yang bernama blobData. Aturlah properti Control Source menggunakan expression builder sehigga properti Control Source= =namaPathFile([blobid]). Control Source ini berisi fungsi namaPathFile yang diambil dari modul mdlBlobBaca.
5. Pada bagian Form Footer, sisipkan sebuah tombol perintah dengan properti sebagai berikut: : Name= cmdBersihkan, Caption= Bersihkan File Temporer. Tujuannya untuk menghapus file yang tidak perlu, sehingga bisa menghemat pemakaian media penyimpanan.

Gamber 3. Data BLOB berupa file di-zip yang dibuka dengan MS Access

Design form frmBlob yang sudah diperbaharui bisa dilihat pada gambar di bawah ini.

Gambar 3. Form design dari frmBlob yang sudah diperbaharui

Berikut ini adalah kode VBA yang ada di modul form Form_frmBlob. Modul Form_frmBlob adalah modul yang ada di posting Menyimpan Data Tipe BLOB di MS Access (link di atas) dan telah diperbaharui sejalan dengan penambahan beberapa control tersebut di atas.

view plainprint?

1. Option Compare Database  
2. Private Const constStrTableName As String = "tblBlob"  
3. Private Const constPrimaryKeyFieldName As String = "blobId"  
4. Private strLocalSql  As String  
5. Private Sub cmdBersihkan_Click()  
6.   bersihkanTempFile  
7. End Sub  
8.   
9.   
10. Private Sub cmdGanti_Click()  
11.   Dim rs As DAO.Recordset  
12.   Dim strPathFile As String  
13.   Dim lngMaxSize As Long  
14.   Dim oleBlobData As Variant, oleBlobBacaData As Variant  
15.   Dim strKriteria As Variant  
16.   Dim strSql As String  
17.     
18.   If Me.blobId = 0 Then  
19.     MsgBox "Tidak ada Blob Id yang teridentifikasi", vbExclamation  
20.     Exit Sub  
21.   End If  
22.   If IsNull(Me.txtNamaFile) Then  
23.     MsgBox "Tidak ada nama file teridentifikasi", vbExclamation  
24.     Me.txtNamaFile.SetFocus  
25.     Exit Sub  
26.   End If  
27.   If Me.txtNamaFile = "" _  
28.     Or Not adaNamaFile(Me.txtNamaFile) Then  
29.     MsgBox "Tidak ada nama file teridentifikasi", vbExclamation  
30.     Me.txtNamaFile.SetFocus  
31.     Exit Sub  
32.   End If  
33.     
34.     
35.   strKriteria = Me.txtKriteria '  
36.   strSql = strLocalSql & " WHERE " & constPrimaryKeyFieldName & "=" & strKriteria  
37.   Set rs = daoDbs.OpenRecordset(strSql, dbOpenDynaset)  
38.   rs.Edit  
39.   If CLng(simpanBlob(Me.txtNamaFile, rs, "blobObjek")) > constBlobMaxSize Then  
40.     MsgBox "Ukuran file lebih besar dari yang dipersyaratkan.", vbExclamation  
41.     Exit Sub  
42.   End If  
43.   oleBlobData = simpanBlob(Me.txtNamaFile, rs, "blobObjek")  
44.   rs!blobNamaFile = uraiPathFile(Me.txtNamaFile)(0)  
45.   rs!blobNamaEkstensi = uraiPathFile(Me.txtNamaFile)(2)  
46.   rs!blobUkuran = CLng(oleBlobData)  
47.   rs.Update  
48.   rs.Bookmark = rs.LastModified  
49.   Me.blobId = rs!blobId  
50.     
51.   If folderTemporer = "" Then Exit Sub  
52.   strPathFile = folderTemporer & rs!blobNamaFile  
53.   oleBlobBacaData = bacaBlob(rs, "blobObjek", strPathFile)  
54.   Me.blobNamaFile = rs!blobNamaFile  
55.   Me.blobNamaEkstensi = rs!blobNamaEkstensi  
56.   Me.blobUkuran = rs!blobUkuran  
57.   Me.blobData.Requery  
58.   
59.   rs.Close  
60.   Set rs = Nothing  
61. End Sub  
62.   
63. Private Sub cmdHapus_Click()  
64.   Dim strKriteria As Variant  
65.   Dim strPesan As String  
66.   strKriteria = Me.blobId  
67.   strPesan = "Data dengan Id nomor " & strKriteria & " akan dihapus?"  
68.   If MsgBox(strPesan, vbYesNo, "Hapus Data BLOB") = vbYes Then  
69.     daoDbs.Execute "DELETE * FROM " & constStrTableName & " WHERE " & constPrimaryKeyFieldName & "=" & strKriteria  
70.     MsgBox "Data dengan Id nomor " & strKriteria & " telah dihapus.", vbInformation  
71.     Me.blobNamaFile = vbNullString  
72.     Me.blobNamaEkstensi = vbNullString  
73.     Me.blobUkuran = vbNullString  
74.     Me.blobId = vbNullString  
75.     Me.blobDeskripsi = vbNullString  
76.     Me.blobMeta = vbNullString  
77.     
78.   End If  
79. End Sub  
80.     
81. Private Sub cmdPilihFile_Click()  
82.   Me.txtNamaFile = kotakFileDialog(Nz(Me.txtNamaFile, ""))  
83.   Me.txtNamaFile.SetFocus  
84. End Sub  
85. Private Sub cmdSimpan_Click()  
86.   Dim rs As DAO.Recordset  
87.   Dim strKriteria As Variant  
88.   Dim strSql As String  
89.   Cancel = False  
90.   If IsNull(Me.blobNamaFile) Then  
91.     MsgBox "Tidak ada file yang disimpan.", vbExclamation  
92.     Cancel = True  
93.     Exit Sub  
94.   End If  
95.   strKriteria = Me.blobId  
96.   strSql = strLocalSql & " WHERE " & constPrimaryKeyFieldName & "=" & strKriteria  
97.   Set rs = daoDbs.OpenRecordset(strSql, dbOpenDynaset)  
98.   rs.Edit  
99.   rs!blobDeskripsi = Me.blobDeskripsi  
100.   rs.Update  
101.   rs.Close  
102.   Set rs = Nothing  
103. End Sub  
104.     
105. Private Sub cmdSimpanTambahBaru_Click()  
106.   cmdSimpan_Click  
107.   If Not Cancel Then cmdPilihFile_Click  
108. End Sub  
109.     
110. Private Sub cmdTambahBaru_Click()  
111.   cmdPilihFile_Click  
112. End Sub  
113.     
114. Private Sub cmdTampilkan_Click()  
115.   Dim rs As DAO.Recordset  
116.   Dim strKriteria As Variant, oleBlobBacaData As Variant  
117.   Dim strSql As String, strPathFile As String  
118.     
119.   If IsNull(Me.txtKriteria) Then Exit Sub  
120.   strKriteria = Me.txtKriteria  
121.   strSql = strLocalSql & " WHERE " & constPrimaryKeyFieldName & "=" & strKriteria  
122.   Set rs = daoDbs.OpenRecordset(strSql, dbOpenDynaset)  
123.     
124.   If adaBlobId(CLng(strKriteria)) Then  
125.     Me.blobId = rs!blobId  
126.     Me.blobMeta = rs!blobMeta  
127.     Me.blobDeskripsi = rs!blobDeskripsi  
128.     Me.blobNamaFile = rs!blobNamaFile  
129.     Me.blobNamaEkstensi = rs!blobNamaEkstensi  
130.       
131.     If folderTemporer = "" Then Exit Sub  
132.     strPathFile = folderTemporer & Me.blobNamaFile  
133.     If Not adaNamaFile(strPathFile) Then oleBlobBacaData = copyBlobObjek(strSql, strPathFile)  
134.     Me.blobData.Requery  
135.   Else  
136.     MsgBox "Tidak ada Blob Id: " & strKriteria, vbExclamation  
137.   End If  
138.   rs.Close  
139.   Set rs = Nothing  
140.     
141. End Sub  
142.   
143. Private Sub cmdUpload_Click()  
144.   Dim rs As DAO.Recordset  
145.   Dim strPathFile As String  
146.   Dim oleBlobData As Variant, oleBlobBacaData As Variant  
147.       
148.   If IsNull(Me.txtNamaFile) Then  
149.     MsgBox "Tidak ada nama file untuk di-upload.", vbExclamation  
150.     Me.txtNamaFile.SetFocus  
151.     Exit Sub  
152.   End If  
153.   If Me.txtNamaFile = "" _  
154.     Or Not adaNamaFile(Me.txtNamaFile) Then  
155.     MsgBox "Tidak ada nama file untuk di-upload.", vbExclamation  
156.     Me.txtNamaFile.SetFocus  
157.     Exit Sub  
158.   End If  
159.   Set rs = daoDbs.OpenRecordset(constStrTableName, dbOpenTable)  
160.   rs.AddNew  
161.   If CLng(simpanBlob(Me.txtNamaFile, rs, "blobObjek")) > constBlobMaxSize Then  
162.     MsgBox "Ukuran file lebih besar dari yang dipersyaratkan.", vbExclamation  
163.     Exit Sub  
164.   End If  
165.   oleBlobData = simpanBlob(Me.txtNamaFile, rs, "blobObjek")  
166.   rs!blobNamaFile = uraiPathFile(Me.txtNamaFile)(0)  
167.   rs!blobNamaEkstensi = uraiPathFile(Me.txtNamaFile)(2)  
168.   rs!blobUkuran = CLng(oleBlobData)  
169.   rs.Update  
170.   rs.Bookmark = rs.LastModified  
171.   Me.blobId = rs!blobId  
172.       
173.   If folderTemporer = "" Then Exit Sub  
174.   strPathFile = folderTemporer & rs!blobNamaFile  
175.   oleBlobBacaData = bacaBlob(rs, "blobObjek", strPathFile)  
176.   Me.blobNamaFile = rs!blobNamaFile  
177.   Me.blobNamaEkstensi = rs!blobNamaEkstensi  
178.   Me.blobUkuran = rs!blobUkuran  
179.   Me.blobData.Requery  
180.     
181.   rs.Close  
182.   Set rs = Nothing  
183. End Sub  
184.     
185. Private Sub Form_Open(Cancel As Integer)  
186.   strLocalSql = "SELECT * FROM " & constStrTableName  
187.   Set daoDbs = CurrentDb()  
188. End Sub  
189. Private Sub cmdBukaFile_Click()  
190.   If Me.blobId <> "" Or Me.blobId <> Null Then  
191.   fHandleFile namaPathFile(Me.blobId), WIN_NORMAL  
192.   End If  
193.   
194. End Sub  

Option Compare Database
Private Const constStrTableName As String = "tblBlob"
Private Const constPrimaryKeyFieldName As String = "blobId"
Private strLocalSql  As String
Private Sub cmdBersihkan_Click()
  bersihkanTempFile
End Sub


Private Sub cmdGanti_Click()
  Dim rs As DAO.Recordset
  Dim strPathFile As String
  Dim lngMaxSize As Long
  Dim oleBlobData As Variant, oleBlobBacaData As Variant
  Dim strKriteria As Variant
  Dim strSql As String
  
  If Me.blobId = 0 Then
    MsgBox "Tidak ada Blob Id yang teridentifikasi", vbExclamation
    Exit Sub
  End If
  If IsNull(Me.txtNamaFile) Then
    MsgBox "Tidak ada nama file teridentifikasi", vbExclamation
    Me.txtNamaFile.SetFocus
    Exit Sub
  End If
  If Me.txtNamaFile = "" _
    Or Not adaNamaFile(Me.txtNamaFile) Then
    MsgBox "Tidak ada nama file teridentifikasi", vbExclamation
    Me.txtNamaFile.SetFocus
    Exit Sub
  End If
  
  
  strKriteria = Me.txtKriteria '
  strSql = strLocalSql & " WHERE " & constPrimaryKeyFieldName & "=" & strKriteria
  Set rs = daoDbs.OpenRecordset(strSql, dbOpenDynaset)
  rs.Edit
  If CLng(simpanBlob(Me.txtNamaFile, rs, "blobObjek")) > constBlobMaxSize Then
    MsgBox "Ukuran file lebih besar dari yang dipersyaratkan.", vbExclamation
    Exit Sub
  End If
  oleBlobData = simpanBlob(Me.txtNamaFile, rs, "blobObjek")
  rs!blobNamaFile = uraiPathFile(Me.txtNamaFile)(0)
  rs!blobNamaEkstensi = uraiPathFile(Me.txtNamaFile)(2)
  rs!blobUkuran = CLng(oleBlobData)
  rs.Update
  rs.Bookmark = rs.LastModified
  Me.blobId = rs!blobId
  
  If folderTemporer = "" Then Exit Sub
  strPathFile = folderTemporer & rs!blobNamaFile
  oleBlobBacaData = bacaBlob(rs, "blobObjek", strPathFile)
  Me.blobNamaFile = rs!blobNamaFile
  Me.blobNamaEkstensi = rs!blobNamaEkstensi
  Me.blobUkuran = rs!blobUkuran
  Me.blobData.Requery

  rs.Close
  Set rs = Nothing
End Sub

Private Sub cmdHapus_Click()
  Dim strKriteria As Variant
  Dim strPesan As String
  strKriteria = Me.blobId
  strPesan = "Data dengan Id nomor " & strKriteria & " akan dihapus?"
  If MsgBox(strPesan, vbYesNo, "Hapus Data BLOB") = vbYes Then
    daoDbs.Execute "DELETE * FROM " & constStrTableName & " WHERE " & constPrimaryKeyFieldName & "=" & strKriteria
    MsgBox "Data dengan Id nomor " & strKriteria & " telah dihapus.", vbInformation
    Me.blobNamaFile = vbNullString
    Me.blobNamaEkstensi = vbNullString
    Me.blobUkuran = vbNullString
    Me.blobId = vbNullString
    Me.blobDeskripsi = vbNullString
    Me.blobMeta = vbNullString
  
  End If
End Sub
  
Private Sub cmdPilihFile_Click()
  Me.txtNamaFile = kotakFileDialog(Nz(Me.txtNamaFile, ""))
  Me.txtNamaFile.SetFocus
End Sub
Private Sub cmdSimpan_Click()
  Dim rs As DAO.Recordset
  Dim strKriteria As Variant
  Dim strSql As String
  Cancel = False
  If IsNull(Me.blobNamaFile) Then
    MsgBox "Tidak ada file yang disimpan.", vbExclamation
    Cancel = True
    Exit Sub
  End If
  strKriteria = Me.blobId
  strSql = strLocalSql & " WHERE " & constPrimaryKeyFieldName & "=" & strKriteria
  Set rs = daoDbs.OpenRecordset(strSql, dbOpenDynaset)
  rs.Edit
  rs!blobDeskripsi = Me.blobDeskripsi
  rs.Update
  rs.Close
  Set rs = Nothing
End Sub
  
Private Sub cmdSimpanTambahBaru_Click()
  cmdSimpan_Click
  If Not Cancel Then cmdPilihFile_Click
End Sub
  
Private Sub cmdTambahBaru_Click()
  cmdPilihFile_Click
End Sub
  
Private Sub cmdTampilkan_Click()
  Dim rs As DAO.Recordset
  Dim strKriteria As Variant, oleBlobBacaData As Variant
  Dim strSql As String, strPathFile As String
  
  If IsNull(Me.txtKriteria) Then Exit Sub
  strKriteria = Me.txtKriteria
  strSql = strLocalSql & " WHERE " & constPrimaryKeyFieldName & "=" & strKriteria
  Set rs = daoDbs.OpenRecordset(strSql, dbOpenDynaset)
  
  If adaBlobId(CLng(strKriteria)) Then
    Me.blobId = rs!blobId
    Me.blobMeta = rs!blobMeta
    Me.blobDeskripsi = rs!blobDeskripsi
    Me.blobNamaFile = rs!blobNamaFile
    Me.blobNamaEkstensi = rs!blobNamaEkstensi
    
    If folderTemporer = "" Then Exit Sub
    strPathFile = folderTemporer & Me.blobNamaFile
    If Not adaNamaFile(strPathFile) Then oleBlobBacaData = copyBlobObjek(strSql, strPathFile)
    Me.blobData.Requery
  Else
    MsgBox "Tidak ada Blob Id: " & strKriteria, vbExclamation
  End If
  rs.Close
  Set rs = Nothing
  
End Sub

Private Sub cmdUpload_Click()
  Dim rs As DAO.Recordset
  Dim strPathFile As String
  Dim oleBlobData As Variant, oleBlobBacaData As Variant
    
  If IsNull(Me.txtNamaFile) Then
    MsgBox "Tidak ada nama file untuk di-upload.", vbExclamation
    Me.txtNamaFile.SetFocus
    Exit Sub
  End If
  If Me.txtNamaFile = "" _
    Or Not adaNamaFile(Me.txtNamaFile) Then
    MsgBox "Tidak ada nama file untuk di-upload.", vbExclamation
    Me.txtNamaFile.SetFocus
    Exit Sub
  End If
  Set rs = daoDbs.OpenRecordset(constStrTableName, dbOpenTable)
  rs.AddNew
  If CLng(simpanBlob(Me.txtNamaFile, rs, "blobObjek")) > constBlobMaxSize Then
    MsgBox "Ukuran file lebih besar dari yang dipersyaratkan.", vbExclamation
    Exit Sub
  End If
  oleBlobData = simpanBlob(Me.txtNamaFile, rs, "blobObjek")
  rs!blobNamaFile = uraiPathFile(Me.txtNamaFile)(0)
  rs!blobNamaEkstensi = uraiPathFile(Me.txtNamaFile)(2)
  rs!blobUkuran = CLng(oleBlobData)
  rs.Update
  rs.Bookmark = rs.LastModified
  Me.blobId = rs!blobId
    
  If folderTemporer = "" Then Exit Sub
  strPathFile = folderTemporer & rs!blobNamaFile
  oleBlobBacaData = bacaBlob(rs, "blobObjek", strPathFile)
  Me.blobNamaFile = rs!blobNamaFile
  Me.blobNamaEkstensi = rs!blobNamaEkstensi
  Me.blobUkuran = rs!blobUkuran
  Me.blobData.Requery
  
  rs.Close
  Set rs = Nothing
End Sub
  
Private Sub Form_Open(Cancel As Integer)
  strLocalSql = "SELECT * FROM " & constStrTableName
  Set daoDbs = CurrentDb()
End Sub
Private Sub cmdBukaFile_Click()
  If Me.blobId <> "" Or Me.blobId <> Null Then
  fHandleFile namaPathFile(Me.blobId), WIN_NORMAL
  End If

End Sub

Berikut ini adalah kode VBA yang ada di form Form_frmBlobBaca. Modul ini khusus digunakan untuk membaca data BLOB.

view plainprint?

1. Option Compare Database  
2. Option Explicit  
3. Const BlockSize = 32768  
4. Function bacaBlob(T As Recordset, sField As String, _  
5. Destination As String)  
6.     Dim intNumBlocks As Integer, intDestFile As Integer, i As Integer  
7.     Dim lngFileLength As Long, lngLeftOver As Long  
8.     Dim strFileData As String  
9.     Dim varRetVal As Variant  
10.   
11.     On Error GoTo Err_bacaBlob  
12.   
13.     lngFileLength = T(sField).FieldSize()  
14.     If lngFileLength = 0 Then  
15.         bacaBlob = 0  
16.         Exit Function  
17.     End If  
18.   
19.     intNumBlocks = lngFileLength \ BlockSize  
20.     lngLeftOver = lngFileLength Mod BlockSize  
21.   
22.     intDestFile = FreeFile  
23.     Open Destination For Output As intDestFile  
24.     Close intDestFile  
25.   
26.     Open Destination For Binary As intDestFile  
27.   
28.     varRetVal = SysCmd(acSysCmdInitMeter, _  
29.     "Writing BLOB", lngFileLength / 1000)  
30.   
31.     strFileData = T(sField).GetChunk(0, lngLeftOver)  
32.     Put intDestFile, , strFileData  
33.   
34.     varRetVal = SysCmd(acSysCmdUpdateMeter, lngLeftOver / 1000)  
35.   
36.     For i = 1 To intNumBlocks  
37.         strFileData = T(sField).GetChunk((i - 1) * BlockSize _  
38.            + lngLeftOver, BlockSize)  
39.         Put intDestFile, , strFileData  
40.   
41.         varRetVal = SysCmd(acSysCmdUpdateMeter, _  
42.         ((i - 1) * BlockSize + lngLeftOver) / 1000)  
43.     Next i  
44.   
45.     varRetVal = SysCmd(acSysCmdRemoveMeter)  
46.     Close intDestFile  
47.     bacaBlob = lngFileLength  
48.     Exit Function  
49.   
50. Err_bacaBlob:  
51.     bacaBlob = -Err  
52.     Exit Function  
53.   
54. End Function  
55. Function namaFile(intBlobId As Integer) As String  
56.   Dim rs As DAO.Recordset  
57.   Set rs = daoDbs.OpenRecordset("SELECT blobNamaFile FROM tblBlob WHERE blobId=" & intBlobId, dbOpenSnapshot)  
58.   If rs.RecordCount = 0 Then  
59.     namaFile = ""  
60.   Else  
61.     namaFile = Nz(rs.Fields("blobNamaFile").Value, "")  
62.   End If  
63.   rs.Close  
64.   Set rs = Nothing  
65. End Function  
66. Function namaPathFile(intBlobId As Integer) As String  
67.   If namaFile(intBlobId) <> "" Then  
68.     namaPathFile = folderTemporer & namaFile(intBlobId)  
69.   Else  
70.     namaPathFile = ""  
71.   End If  
72.   
73. End Function  
74. Function adaBlobId(lngBlobDataId As Long) As Boolean  
75. Dim lngBlobId As Long  
76. On Error GoTo Err_Msg  
77.   lngBlobId = DCount("*", "tblBlob", "blobId=" & lngBlobDataId)  
78.   adaBlobId = False  
79.   If lngBlobId > 0 Then adaBlobId = True  
80. Exit_Function:  
81.   Exit Function  
82. Err_Msg:  
83.   MsgBox "Function adaBlobId, Error # " & str(Err.Number) & ", source: " & Err.Source & _  
84.   Chr(13) & Err.description  
85.   Resume Exit_Function  
86. End Function  
87. Function bersihkanTempFile()  
88.   Dim objFSO  As Object, objFolder  As Object  
89.   Set objFSO = CreateObject("Scripting.FileSystemObject")  
90.     
91.   objFSO.DeleteFile (folderTemporer & "*.*")  
92.   Set objFSO = Nothing  
93. End Function  
94. Function copyBlobObjek(strTbl As String, strFilePath As String) As Variant 'OK  
95.   
96.   Dim rst As DAO.Recordset  
97. On Error GoTo Err_Msg  
98.   Set rst = daoDbs.OpenRecordset(strTbl, dbOpenSnapshot)  
99.   copyBlobObjek = bacaBlob(rst, "blobObjek", strFilePath)  
100.   rst.Close  
101.   Set rst = Nothing  
102. Exit_Function:  
103.   Exit Function  
104. Err_Msg:  
105.   MsgBox "Function copyBlobObjek, Error # " & str(Err.Number) & ", source: " & Err.Source & _  
106.   Chr(13) & Err.description  
107.   Resume Exit_Function  
108. End Function  

Option Compare Database
Option Explicit
Const BlockSize = 32768
Function bacaBlob(T As Recordset, sField As String, _
Destination As String)
    Dim intNumBlocks As Integer, intDestFile As Integer, i As Integer
    Dim lngFileLength As Long, lngLeftOver As Long
    Dim strFileData As String
    Dim varRetVal As Variant

    On Error GoTo Err_bacaBlob

    lngFileLength = T(sField).FieldSize()
    If lngFileLength = 0 Then
        bacaBlob = 0
        Exit Function
    End If

    intNumBlocks = lngFileLength \ BlockSize
    lngLeftOver = lngFileLength Mod BlockSize

    intDestFile = FreeFile
    Open Destination For Output As intDestFile
    Close intDestFile

    Open Destination For Binary As intDestFile

    varRetVal = SysCmd(acSysCmdInitMeter, _
    "Writing BLOB", lngFileLength / 1000)

    strFileData = T(sField).GetChunk(0, lngLeftOver)
    Put intDestFile, , strFileData

    varRetVal = SysCmd(acSysCmdUpdateMeter, lngLeftOver / 1000)

    For i = 1 To intNumBlocks
        strFileData = T(sField).GetChunk((i - 1) * BlockSize _
           + lngLeftOver, BlockSize)
        Put intDestFile, , strFileData

        varRetVal = SysCmd(acSysCmdUpdateMeter, _
        ((i - 1) * BlockSize + lngLeftOver) / 1000)
    Next i

    varRetVal = SysCmd(acSysCmdRemoveMeter)
    Close intDestFile
    bacaBlob = lngFileLength
    Exit Function

Err_bacaBlob:
    bacaBlob = -Err
    Exit Function

End Function
Function namaFile(intBlobId As Integer) As String
  Dim rs As DAO.Recordset
  Set rs = daoDbs.OpenRecordset("SELECT blobNamaFile FROM tblBlob WHERE blobId=" & intBlobId, dbOpenSnapshot)
  If rs.RecordCount = 0 Then
    namaFile = ""
  Else
    namaFile = Nz(rs.Fields("blobNamaFile").Value, "")
  End If
  rs.Close
  Set rs = Nothing
End Function
Function namaPathFile(intBlobId As Integer) As String
  If namaFile(intBlobId) <> "" Then
    namaPathFile = folderTemporer & namaFile(intBlobId)
  Else
    namaPathFile = ""
  End If

End Function
Function adaBlobId(lngBlobDataId As Long) As Boolean
Dim lngBlobId As Long
On Error GoTo Err_Msg
  lngBlobId = DCount("*", "tblBlob", "blobId=" & lngBlobDataId)
  adaBlobId = False
  If lngBlobId > 0 Then adaBlobId = True
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Function adaBlobId, Error # " & str(Err.Number) & ", source: " & Err.Source & _
  Chr(13) & Err.description
  Resume Exit_Function
End Function
Function bersihkanTempFile()
  Dim objFSO  As Object, objFolder  As Object
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  
  objFSO.DeleteFile (folderTemporer & "*.*")
  Set objFSO = Nothing
End Function
Function copyBlobObjek(strTbl As String, strFilePath As String) As Variant 'OK

  Dim rst As DAO.Recordset
On Error GoTo Err_Msg
  Set rst = daoDbs.OpenRecordset(strTbl, dbOpenSnapshot)
  copyBlobObjek = bacaBlob(rst, "blobObjek", strFilePath)
  rst.Close
  Set rst = Nothing
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Function copyBlobObjek, Error # " & str(Err.Number) & ", source: " & Err.Source & _
  Chr(13) & Err.description
  Resume Exit_Function
End Function

Untuk memperoleh contoh aplikasi BLOB, silakan ikuti petunjuk di bawah ini:

1. Follow on Facebook yang ada di kotak sebelah kanan blog Access Terapan dengan memilih Following.
2. Setelah itu, kirim email ke admin a.n. bambang.subro@gmail.com untuk memperoleh akses ke Google Drive Access Terapan.
3. Setelah akses diperoleh, silakan buka Googlr Drive lalu klik bagian silakan download file blobSimpanBaca.zip. File ini berisi 5 objek Access:
   1. Tabel yang bernama tblBlob, khusus untuk menyimpan data BLOB beserta properti/metadata
   2. Form yang bernama frmBlob, khusus untuk antarmuka antara user dengan tblBlob. Di dalamnya berisi class modul Frm_frmBlob.
   3. Tiga Modul yang bernama mdlAPI, mdlBlobSimpan, dan mdlBaca digunakan untuk memporses upload file ke dalam database di tblBlob dan menampilkannya kembali.
4. Bukalah form frmBlob dalam format Form View.
5. Sebagai uji coba lakukan upload file (apa saja terserah), yang penting tidak boleh melebihi batas maksimum ukuran file yang dipersyaratkan pada deklarasi konstanta Public Const constBlobMaxSize.