Menyimpan dan menampilkan foto di ms access

Disini saya tidak akan menjelaskan bagaimana melakukan koneksi ke database access, intinya aplikasi Anda sudah siap menjalankan perintah SELECT, INSERT, UPDATE, dan DELETE.
Untuk kasus disini kita akan menyimpan data mahasiswa dengan tiga field saja, lihat gambar berikut :

Khusus untuk field foto tipe yang dipilih adalah OLE Object, kita langsung aja copy paste kode berikut di module :

001	Option Explicit

002

003	Public Const CHUNK_SIZE     As Long = 16384

004

005	Dim rsImage                 As ADODB.Recordset

006

007	Dim i                       As Long

008	Dim lsize                   As Long

009	Dim iChunks                 As Long

010	Dim nFragmentOffset         As Long

011	Dim lchunks                 As Long

012

013	Dim nHandle                 As Integer

014	Dim varChunk()              As Byte

015

016	Public Function fileExists(ByVal strNamaFile As String) As Boolean

017	If Not (Len(strNamaFile) > 0) Then fileExists = False: Exit Function

018

019	If Dir$(strNamaFile, vbNormal) = "" Then

020	fileExists = False

021

Else

022	fileExists = True

023

End If

024	End Function

025

026	Public Sub closeRecordset(ByVal vRs As ADODB.Recordset)

027	On Error Resume Next

028

029	If Not (vRs Is Nothing) Then

030	If vRs.State = adStateOpen Then

031

vRs.Close

032	Set vRs = Nothing

033

End If

034

End If

035

End Sub

036

037	Public Function addImageToDB(ByVal query As String, ByVal imageName As String, ByVal imageField As String) As Boolean

038	On Error GoTo errHandle

039

040	Set rsImage = New ADODB.Recordset

041	rsImage.Open query, conn, adOpenKeyset, adLockOptimistic

042	If Not rsImage.EOF Then

043	nHandle = FreeFile

044	Open imageName For Binary Access Read As nHandle

045	lsize = LOF(nHandle)

046	If nHandle = 0 Then Close nHandle

047

048	lchunks = lsize / CHUNK_SIZE

049	nFragmentOffset = lsize Mod CHUNK_SIZE

050

051	ReDim varChunk(nFragmentOffset)

052	Get nHandle, , varChunk()

053	rsImage(imageField).AppendChunk varChunk()

054

055	ReDim varChunk(CHUNK_SIZE)

056	For i = 1 To lchunks

057	Get nHandle, , varChunk()

058	rsImage(imageField).AppendChunk varChunk()

059

DoEvents

060

Next

061	rsImage.Update

062

End If

063	Call closeRecordset(rsImage)

064

065	addImageToDB = True

066

067	Exit Function

068	errHandle:

069	addImageToDB = False

070	End Function

071

072	Public Function getImageFromDB(ByVal query As String) As IPictureDisp

073	Dim sFile           As String

074

075	On Error GoTo errHandle

076

077	Set rsImage = New ADODB.Recordset

078	rsImage.Open query, conn, adOpenForwardOnly, adLockReadOnly

079	If Not rsImage.EOF Then

080	If Not IsNull(rsImage(0).Value) Then

081	nHandle = FreeFile

082

083	sFile = App.Path & "\output.bin"

084	If fileExists(sFile) Then Kill sFile

085

DoEvents

086

087	Open sFile For Binary Access Write As nHandle

088

089	lsize = rsImage(0).ActualSize

090	iChunks = lsize \ CHUNK_SIZE

091	nFragmentOffset = lsize Mod CHUNK_SIZE

092

093	varChunk() = rsImage(0).GetChunk(nFragmentOffset)

094	Put nHandle, , varChunk()

095	For i = 1 To iChunks

096	ReDim varChunk(CHUNK_SIZE) As Byte

097

098	varChunk() = rsImage(0).GetChunk(CHUNK_SIZE)

099	Put nHandle, , varChunk()

100

DoEvents

101

Next

102	Close nHandle

103

104	Set getImageFromDB = LoadPicture(sFile, , vbLPColor)

105

106

Else

107	Set getImageFromDB = Nothing

108

End If

109

110

Else

111	Set getImageFromDB = Nothing

112

End If

113	Call closeRecordset(rsImage)

114

115	Exit Function

116	errHandle:

117	Set getImageFromDB = Nothing

118	End Function

Untuk di form cukup dengan kode sederhana berikut :

01	Private Sub cmdSimpan_Click()

02	'untuk format gambar bisa JPG atau BMP

03	strSql = "INSERT INTO mhs (nim, nama) VALUES ('" & txtNIM.Text & "', '" & txtNama.Text & "')"

04	conn.Execute strSql

05

06	If fileExists(txtLokasiFoto.Text) Then

07	strSql = "SELECT nim, foto FROM mhs WHERE nim = '" & txtNIM.Text & "'"

08	If Not addImageToDB(strSql, txtLokasiFoto.Text, "foto") Then MsgBox "Foto mahasiswa gagal disimpan !"

09

End If

10

End Sub

11

12	Private Sub cmdTampil_Click()

13	strSql = "SELECT foto FROM mhs WHERE nim = '" & txtNIM.Text & "'"

14	Set picMhs.Picture = getImageFromDB(strSql)

15

End Sub

Selamat mencoba