Skip to main content

Menyimpan Data Tipe BLOB di MS Access

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.
  1. Field Name: blobId
    1. Field Description: Nomor urut BLOB object
    2. Properti:
      1. Caption: BlobId
      2. Type: Long Integer (Autonumber)
  2. Field Name: blobObjek
    1. Field Description: Sisipkan sebuah objek BLOB di sini
    2. Properti:
      1. Caption: Objek BLOB
      2. Type: OLE Object
  3. Field Name: blobMeta
    1. Field Description: Metadata dari objek BLOB
    2. Properti:
      1. Caption: Meta Data
      2. Type: Text
  4. Field Name: blobNamaFile
    1. Field Description: Nama file orisinil dari objek BLOB
    2. Properti:
      1. Caption: Nama File
      2. Type: Text
  5. Field Name: blobNamaEkstensi
    1. Field Description: Nama ekstensi orisinil dari objek BLOB
    2. Properti:
      1. Caption: Nama Ekstensi
      2. Type: Text
  6. Field Name: blobUkuran
    1. Field Description: Ukuran file orisinil dari objek BLOB
    2. Properti:
      1. Caption: Ukuran
      2. Type: Long Integer (Number)
  7. Field Name: blobDeskripsi
    1. Field Description: Deskripsi ringkas dari objek BLOB
    2. Properti:
      1. Caption: Deskripsi
      2. Type: Text
Setelah tabel tblBlob beserta field yang ada di dalamnya selesai dibuat, langkah selanjutnya adalah membuat sebuah form. Untuk itu, sorotlah tblBlob lalu pilih tab Ribbon Create, dan buat sebuah form dengan menggunakan salah satu tombol yang ada di Group Forms. Pilih saja cara membuat form yang paling nyaman di antara tombol Form, Blank Form, Form Wizard, dan Form Design. Misalkan, kita menggunakan tombol Form. Hasilnya akan seperti ini:
Ikuti langkah-langkah di bawah ini:
  1. Simpanlah form yang baru saja dibuat dengan nama frmBlob.
  2. Hapuslah tipe form control Bound Object Frame yang bernama blobObjek.
  3. Sisipkan sebuah tipe control Image untuk mengganti Bound Object Frame dengan menekan tombol Image di Group Control. Properti control itu adalah sbb:
    1. Name=blobData
    2. 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:
  4. Pada bagian Form Header, sisipkan sebuah text box control dan 2 buah tombol perintah. Propertinya adalah sbb:
    1. Text Box, Name= txtNameFile, label untuk text box ini, Caption=Upload File
    2. Button (Form Control), Name=cmdUpload, Caption=Upload File Baru
    3. Button (Form Control), Name=cmdPilihFile, Caption=Pilih File, Picture=Open Folder
  5. Pada bagian Form Footer, sisipkan beberapa tombol perintah berikut ini:
    1. Button (Form Control), Name=cmdSimpan, Caption=Simpan
    2. Button (Form Control), Name=cmdSimpanTambahBaru, Caption=Simpan, Tambah Data Baru
    3. Button (Form Control), Name=cmdTambahBaru, Caption=Tambah Data Baru
    4. Button (Form Control), Name=cmdHapus, Caption=Hapus
  6. 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.
  7. 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.
Design view dari frmBlob, setelah mengalami perubahan adalah sebagai berikut:

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:
  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. 
  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 file blobSimpan.zip.File ini berisi 3 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. Modul yang bernama mdlBlob, digunakan untuk memporses upload file ke dalam database di tblBlob.
  5. Bukalah form frmBlob dalam format Form View.
  6. 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.

Comments

  1. sangat bermanfaat
    saya 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

    ReplyDelete
    Replies
    1. 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

Post a Comment

Posting Terpopuler

Normalisasi, Denormalisasi, dan Anomali Database

Membuat Fungsi Untuk Menghitung Pajak Penghasilan PPh 21 di MS Access

Format Untuk Field Dengan Tipe Data Number dan Currency di MS Access