Simpan Gambar Ke Ms. Acces 2000 dengan Visual Basic 6.0 (VB6)

Penyimpanan data berupa Image atau gambar ke database terkadang sering kita jumpai seperti data-data mahasiswa, siswa, pegawai dan masih banyak lainnya tergantung dari aplikasi tersebut mengelola data tentang apa. Untuk kali ini akan kita uraikan dalam source code pembahasan Simpan Gambar Ke Ms. Acces 2000 tipe field yang untuk dapat menyimpan data berupa gambar OLE Object. Langsung saja pada pokok pembahasan buka Microsoft Visual Basic 6.0 (VB6) kemudian klik menu Project - References kemudian cari dan ceklis Microsoft ActiveX Data Objects 2.8 Library dan klik OK. Kemudian dilanjutkan untuk komponen-komponen yang akan kita gunakan adalah seperti berikut :  

1. Image1

2. TextBox

3. Microsot Common Dialog Control 6.0

4. CommandButton

5. Module

Susun dan designlah tata letak dari beberapa komponen diatas pada form agar terlihat rapi, seperti gambar dibawah ini : 

Link Download

Source Code Simpan Gambar Ke Ms. Acces 2000

Untuk CommandButton disini ada 7 dengan nama yang sengaja dirubah supaya gampang dalam pemberian syntac

cmdLoad (cmdLoadGambar)

Private Sub cmdLOad_Click()
On Error GoTo pesan
With CommonDialog1
    .DialogTitle = "Pilih Logo Perusahaan"
    .Filter = "Files *.jpg, *.ico, *.gif |*.jpg;*.bmp;*.ico;*.gif"
    .ShowOpen
End With
If Not CommonDialog1.CancelError And CommonDialog1.FileName <> "" Then
    Image1.Picture = LoadPicture(CommonDialog1.FileName)
    lblPath.Caption = CommonDialog1.FileName
End If
pesan:
    If (Err.Number = 481) Then
    MsgBox "Gambar Tidak bisa diload", vbCritical, "Error Load Gambar"
    Exit Sub
    End If
End Sub

cmdCari

Private Sub cmdCari_Click()
If Text1.Text <> "" Then
    Set RsSiswa = New ADODB.Recordset
    RsSiswa.Open "SELECT * FROM tblSiswa where NIS='" & Text1.Text & "'", CN, 1, 2
    If RsSiswa.RecordCount > 0 Then
      If LoadPictureFromDB(RsSiswa, Image1) Then
      End If
    Else
      Set Image1.Picture = Nothing
    End If
End If
End Sub

cmdSimpan

Private Sub cmdSimpan_Click()
If Text1.Text = "" Then
   MsgBox "Seluruh data harus diinputkan dengan lengkap !", vbExclamation, "Perhatian"
Else
    Set RsSiswa = New ADODB.Recordset
    RsSiswa.Open "SELECT * FROM tblSiswa where NIS='" & Text1.Text & "'", CN, 1, 2
    If RsSiswa.RecordCount = 0 Then
           RsSiswa.AddNew
           RsSiswa.Fields!NIS = Text1.Text
                If SavePictureToDB(RsSiswa, CommonDialog1.FileName) = True Then
                End If
           RsSiswa.Update
    Else
           RsSiswa.Fields!NIS = Text1.Text
                If SavePictureToDB(RsSiswa, CommonDialog1.FileName) = True Then
                End If
           RsSiswa.Update
    End If
End If
End Sub

cmdHapus

Private Sub cmdhapus_Click()
If Text1.Text <> "" Then
    Dim A As Byte
    A = MsgBox("Hapus data ?", vbYesNo + vbInformation, "Perhatian")
    If A = vbYes Then
       CN.Execute "delete from tblsiswa where nis='" & Text1.Text & "'"
       Text1.Text = ""
       Set Image1.Picture = Nothing
    End If
End If
End Sub 

cmdKeluar 

Private Sub cmdKeluar_Click()
End
End Sub

Module 1 

Public CN As New ADODB.Connection
Public RsSiswa As New ADODB.Recordset

Sub Koneksi()
Dim PathDb As String
PathDb = App.Path & "\dbsiswa.mdb"
If CN.State Then
   CN.Close
   CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & PathDb & ";Persist Security Info=False"
   CN.CursorLocation = adUseClient
Else
   CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & PathDb & ";Persist Security Info=False"
   CN.CursorLocation = adUseClient
End If
Exit Sub
End Sub

Sub Main()
Call Koneksi
Form1.Show
End Sub

Jika telah selesai, kemudian simpan dan Run/F5 inputkan beberapa data dan gambarnya kemudian tekan tombol simpan, kemudian panggil data yang telah tersimpan didalam database dengan menggunakan menuliskan NPM pada TextBox, maka secara otomatis gambar (image) akan tampil