Seperti telah dijelaskan di posting terdahulu, BLOB atau Binary Large Object Bitmap merupakan tipe data biner yang digunakan untuk menyimpan objek berupa file ke dalam suatu database. Di MS Access kita juga bisa membuat sebuah database yang digunakan khusus untuk menyimpan objek berupa file. Ikuti caranya pada pembahasan berikut ini.
Untuk mudahnya, kita akan membuat sebuah database. Namailah database itu blob.accdb. Database blob.accdb ini hanya akan berisi sebuah tabel yang akan digunakan untuk mengelola data yang berupa file. apa pun tipe file nya. Oleh karena itu supaya database blob.accdb ini informatif, maka kita akan membuat sebuah tabel, sebutlah nama tabel itu tblBlob. Berikut ini adalah field beserta propertinya yang ada dalam tblBlob.
Ikuti langkah-langkah di bawah ini:
Selanjutnya, kita menuliskan kode VBA melalui modul. Ada dua modul yang harus dibuat. Modul yang pertama berkaitan dengan form frmBlob, yang merupakan class module. Sedangkan modul yang kedua merupakan standard module yang berisi kode VBA khusus untuk menyimpan data BLOB yang dilakukan melalui form frmBlob beserta class module Form_frmBlob. Kita beri nama standard module itu mdlBlob.
Untuk mudahnya, kita akan membuat sebuah database. Namailah database itu blob.accdb. Database blob.accdb ini hanya akan berisi sebuah tabel yang akan digunakan untuk mengelola data yang berupa file. apa pun tipe file nya. Oleh karena itu supaya database blob.accdb ini informatif, maka kita akan membuat sebuah tabel, sebutlah nama tabel itu tblBlob. Berikut ini adalah field beserta propertinya yang ada dalam tblBlob.
- Field Name: blobId
- Field Description: Nomor urut BLOB object
- Properti:
- Caption: BlobId
- Type: Long Integer (Autonumber)
- Field Name: blobObjek
- Field Description: Sisipkan sebuah objek BLOB di sini
- Properti:
- Caption: Objek BLOB
- Type: OLE Object
- Field Name: blobMeta
- Field Description: Metadata dari objek BLOB
- Properti:
- Caption: Meta Data
- Type: Text
- Field Name: blobNamaFile
- Field Description: Nama file orisinil dari objek BLOB
- Properti:
- Caption: Nama File
- Type: Text
- Field Name: blobNamaEkstensi
- Field Description: Nama ekstensi orisinil dari objek BLOB
- Properti:
- Caption: Nama Ekstensi
- Type: Text
- Field Name: blobUkuran
- Field Description: Ukuran file orisinil dari objek BLOB
- Properti:
- Caption: Ukuran
- Type: Long Integer (Number)
- Field Name: blobDeskripsi
- Field Description: Deskripsi ringkas dari objek BLOB
- Properti:
- Caption: Deskripsi
- Type: Text
Ikuti langkah-langkah di bawah ini:
- Simpanlah form yang baru saja dibuat dengan nama frmBlob.
- Hapuslah tipe form control Bound Object Frame yang bernama blobObjek.
- Sisipkan sebuah tipe control Image untuk mengganti Bound Object Frame dengan menekan tombol Image di Group Control. Properti control itu adalah sbb:
- Name=blobData
- Control Source= untuk sementara, control ini dikosongkan (unbound). Control Source ini akan diisi expression builder saat kita membahas cara membaca data tipe BLOB.
Design view setelah pergantian control adalah sbb:
- Pada bagian Form Header, sisipkan sebuah text box control dan 2 buah tombol perintah. Propertinya adalah sbb:
- Text Box, Name= txtNameFile, label untuk text box ini, Caption=Upload File
- Button (Form Control), Name=cmdUpload, Caption=Upload File Baru
- Button (Form Control), Name=cmdPilihFile, Caption=Pilih File, Picture=Open Folder
- Pada bagian Form Footer, sisipkan beberapa tombol perintah berikut ini:
- Button (Form Control), Name=cmdSimpan, Caption=Simpan
- Button (Form Control), Name=cmdSimpanTambahBaru, Caption=Simpan, Tambah Data Baru
- Button (Form Control), Name=cmdTambahBaru, Caption=Tambah Data Baru
- Button (Form Control), Name=cmdHapus, Caption=Hapus
- Hapus semua properti Control Source yang terhubung (bound) ke tabel tblBlob sehingga semua Control Source tidak terisi atau Unbound. Jadi nama-nama control berikut ini tidak mempunyai nilai Control Source: blobId, blobMeta, blobNamaFile, blobNamaEkstensi, blobUkuran, dan blobDeskripsi. Selain itu, properti Record Source dari form frmBlob juga Unbound.
- Langkah terakhir, untuk melindungi metadata file dari pengeditan yang tidak perlu, aturlah properti Enabled=False untuk control berikut ini: blobId, blobMeta, blobNamaFile, blobNamaEkstensi, dan blobUkuran.
Selanjutnya, kita menuliskan kode VBA melalui modul. Ada dua modul yang harus dibuat. Modul yang pertama berkaitan dengan form frmBlob, yang merupakan class module. Sedangkan modul yang kedua merupakan standard module yang berisi kode VBA khusus untuk menyimpan data BLOB yang dilakukan melalui form frmBlob beserta class module Form_frmBlob. Kita beri nama standard module itu mdlBlob.
Berikut ini adalah kode VBA yang ada di form Form_frmBlob:
Option Compare Database
Private Const constStrTableName As String = "tblBlob"
Private Const constPrimaryKeyFieldName As String = "blobId"
Private strLocalSql As String
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 cmdUpload_Click()
Dim rs As DAO.Recordset
Dim strPathFile As String
Dim oleBlobData 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
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
Berikut ini adalah kode VBA yang ada di modul mdlBlob:
Option Compare Database
Option Explicit
Const BlockSize = 32768
Const UNIQUE_NAME = &H0
Const constSeparatorCharacter As String = ","
Public Const constBlobMaxSize As Long = 20000000
Private Declare Function GetTempPathA Lib "kernel32" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Const dbOpenTable = DB_OPEN_TABLE
Const acSysCmdInitMeter = SYSCMD_INITMETER
Const acSysCmdUpdateMeter = SYSCMD_UPDATEMETER
Const acSysCmdRemoveMeter = SYSCMD_REMOVEMETER
Public daoDbs As DAO.Database
Function simpanBlob(Source As String, T As Recordset, _
sField As String) As Variant
Dim intNumBlocks As Integer, intSourceFile As Integer, i As Integer
Dim lngFileLength As Long, lngLeftOver As Long, lngFileSize As Long
Dim strFileData As String
Dim varRetVal As Variant
On Error GoTo Err_simpanBlob
intSourceFile = FreeFile
Open Source For Binary Access Read As intSourceFile
lngFileLength = LOF(intSourceFile)
If lngFileLength = 0 Or lngFileLength > constBlobMaxSize Then
simpanBlob = lngFileLength
Exit Function
End If
intNumBlocks = lngFileLength \ BlockSize
lngLeftOver = lngFileLength Mod BlockSize
varRetVal = SysCmd(acSysCmdInitMeter, "Reading BLOB", _
lngFileLength \ 1000)
strFileData = String$(lngLeftOver, 32)
Get intSourceFile, , strFileData
T(sField).AppendChunk (strFileData)
varRetVal = SysCmd(acSysCmdUpdateMeter, lngLeftOver / 1000)
strFileData = String$(BlockSize, 32)
For i = 1 To intNumBlocks
Get intSourceFile, , strFileData
T(sField).AppendChunk (strFileData)
varRetVal = SysCmd(acSysCmdUpdateMeter, BlockSize * i / 1000)
Next i
varRetVal = SysCmd(acSysCmdRemoveMeter)
Close intSourceFile
simpanBlob = lngFileLength
Exit Function
Err_simpanBlob:
simpanBlob = -Err
Exit Function
End Function
Function uraiPathFile(strFilePath As String) As Variant
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
uraiPathFile = Array(objFSO.GetFileName(strFilePath), _
objFSO.GetBaseName(strFilePath), _
objFSO.GetExtensionName(strFilePath) _
)
Set objFSO = Nothing
End Function
Function buatFolderTemporer() As String
Dim objFSO As Object, objFolder As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.createFolder(folderPathTemporer & "blob")
Set objFolder = Nothing
Set objFSO = Nothing
End Function
Function folderTemporer() As String
Dim strTempFolder As String
Dim objFSO As Object, objFolder As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
folderTemporer = ""
If Not objFSO.FolderExists(folderPathTemporer & "blob") Then buatFolderTemporer
strTempFolder = tambahkanBackslash(folderPathTemporer & "blob")
folderTemporer = strTempFolder
Set objFSO = Nothing
End Function
Function tambahkanBackslash(s As String) As String
If Len(s) > 0 Then
If Right$(s, 1) <> "\" Then
tambahkanBackslash = s + "\"
Else
tambahkanBackslash = s
End If
Else
tambahkanBackslash = "\"
End If
End Function
Function kotakFileDialog(Optional strFileName As String = "", Optional boolAllowMultiSelect As Boolean = False) As String
'aktifkan Microsoft Office Object Library di Tools > References... (minimum versi 12.0)
Dim fd As Office.FileDialog
Dim vrtSelectedItem As Variant, itemFile() As String, i As Integer
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = boolAllowMultiSelect
.Title = "Memilih File"
.Filters.Clear
.ButtonName = "Pilih"
If .Show Then
If .AllowMultiSelect Then
ReDim Preserve itemFile(.SelectedItems.Count - 1)
i = 0
For Each vrtSelectedItem In .SelectedItems
itemFile(i) = vrtSelectedItem
i = i + 1
Next vrtSelectedItem
kotakFileDialog = Join(itemFile, ",")
Else
kotakFileDialog = .SelectedItems.Item(1)
End If
Else
If strFileName <> "" Then kotakFileDialog = strFileName
End If
End With
Set fd = Nothing
End Function
Function adaNamaFile(strFileName As String) As Boolean
Dim objFSO As Object, objFolder As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
adaNamaFile = False
If objFSO.FileExists(strFileName) Then adaNamaFile = True
Set objFSO = Nothing
End Function
Function folderPathTemporer() As String
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
folderPathTemporer = pathTemporer
Set objFSO = Nothing
End Function
Private Function pathTemporer() As String
Dim sTmp As String
Dim i As Integer
i = GetTempPathA(0, "")
sTmp = Space(i)
Call GetTempPathA(i, sTmp)
pathTemporer = tambahkanBackslash(Left$(sTmp, i - 1))
End Function
Untuk memperoleh contoh aplikasi BLOB, silakan ikuti petunjuk di bawah ini:
- 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.
- Kirim email ke admin yanto.e.subroto@gmail.com untuk diikutsertakan menjadi anggota grup Access Terapan.
- Sebagai tanda bukti keanggotaan, admin grup Access Terapan akan mengirimkan email ke alamat yang dituju.
- Selanjutnya, silakan download file blobSimpan.zip.File ini berisi 3 objek Access.
- Tabel yang bernama tblBlob, khusus untuk menyimpan data BLOB beserta properti/metadata
- Form yang bernama frmBlob, khusus untuk antarmuka antara user dengan tblBlob. Di dalamnya berisi class modul Frm_frmBlob.
- Modul yang bernama mdlBlob, digunakan untuk memporses upload file ke dalam database di tblBlob.
- Bukalah form frmBlob dalam format Form View.
- 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.




sangat bermanfaat
ReplyDeletesaya mencoba langkah demi langkah, tapi LongBinaryData yang tersimpan di OLE Object, ketika saya coba melakukan debug.print untuk melihat isinya, hasilnya bukan binary, tapi hasilnya seperti ini
/ ©Ë¨7¸ô¥ kSÍÕ ¾eÇ 8S....dst
itu kenapa ya?
mohon pencerahannya
Itu kode biner kalau data ole didebug. Saat di form, data blob dapat berupa gambar atau hanya nama file. Untuk membukanya, harus menggunakan aplikasi yg didefault Windows.
Delete