Untuk menyimpan gambar di ms access tipe field yang digunakan adalah OLE
Object, setelah itu Anda bisa menggunakan kode berikut. Kode di copy paste di
modul :
Option Explicit
Public Const CHUNK_SIZE As Long = 16384
Dim rsImage As ADODB.Recordset
Dim i As Long
Dim lsize As Long
Dim iChunks As Long
Dim nFragmentOffset As Long
Dim lchunks As Long
Dim nHandle As Integer
Dim varChunk() As Byte
Public Function fileExists(ByVal strNamaFile As String) As Boolean
If Not (Len(strNamaFile) > 0) Then fileExists = False: Exit Function
If Dir$(strNamaFile, vbNormal) = "" Then
fileExists = False
Else
fileExists = True
End If
End
Function
Public Sub closeRecordset(ByVal vRs As ADODB.Recordset)
On Error Resume Next
If Not (vRs Is Nothing) Then
If vRs.State = adStateOpen Then
vRs.Close
Set vRs = Nothing
End If
End If
End Sub
Public Function addImageToDB(ByVal query As String, ByVal imageName As String,
ByVal imageField As String) As Boolean
On Error GoTo errHandle
Set rsImage = New ADODB.Recordset
rsImage.Open query, conn, adOpenKeyset, adLockOptimistic
If Not rsImage.EOF Then
nHandle = FreeFile
Open imageName For Binary Access Read As nHandle
lsize = LOF(nHandle)
If nHandle = 0 Then Close nHandle
lchunks = lsize / CHUNK_SIZE
nFragmentOffset = lsize Mod CHUNK_SIZE
ReDim chunk(nFragmentOffset)
Get nHandle, , chunk()
rsImage(imageField).AppendChunk
chunk()
ReDim chunk(CHUNK_SIZE)
For i = 1 To lchunks
Get nHandle, , chunk()
rsImage(imageField).AppendChunk chunk()
DoEvents
Next
rsImage.Update
End If
Call closeRecordset(rsImage)
addImageToDB = True
Exit Function
errHandle:
addImageToDB = False
End Function
Public Function getImageFromDB(ByVal query As String) As IPictureDisp
Dim sFile As String
On Error GoTo errHandle
Set rsImage = New ADODB.Recordset
rsImage.Open query, conn, adOpenForwardOnly, adLockReadOnly
If Not rsImage.EOF Then
If Not IsNull(rsImage(0).Value) Then
nHandle = FreeFile
sFile = App.Path & "\output.bin"
If fileExists(sFile) Then Kill sFile
DoEvents
Open sFile For Binary Access Write As
nHandle
lsize = rsImage(0).ActualSize
iChunks = lsize \ CHUNK_SIZE
nFragmentOffset = lsize Mod CHUNK_SIZE
varChunk() = rsImage(0).GetChunk(nFragmentOffset)
Put nHandle, , varChunk()
For i = 1 To iChunks
ReDim varChunk(CHUNK_SIZE) As Byte
varChunk() = rsImage(0).GetChunk(CHUNK_SIZE)
Put nHandle, , varChunk()
DoEvents
Next
Close nHandle
Set getImageFromDB = LoadPicture(sFile, , vbLPColor)
Else
Set getImageFromDB = Nothing
End If
Else
Set getImageFromDB = Nothing
End If
Call closeRecordset(rsImage)
Exit Function
errHandle:
Set getImageFromDB = Nothing
End Function
berikut contoh penggunaan fungsi addImageToDB dan getImageFromDB :
Private Sub cmdSimpan_Click()
'untuk format foto baru bisa JPG, BMP
strSql = "INSERT INTO mhs (nim, nama) VALUES ('" & txtNIM.Text & "', '" &
txtNama.Text & "')"
conn.Execute strSql
strSql = "SELECT nim, foto FROM mhs WHERE nim = '" & txtNIM.Text & "'"
If Not addImageToDB(strSql, txtLokasiFoto.Text, "foto") Then MsgBox "Foto
mahasiswa gagal disimpan !"
End Sub
Private Sub cmdTampil_Click()
strSql = "SELECT foto FROM mhs WHERE nim = '" & txtNIM.Text & "'"
Set picMhs.Picture = getImageFromDB(strSql)
End Sub
Selamat mencoba :)
sumber :
http://coding4ever.wordpress.com/2009/12/29/menyimpan-dan-menampilkan-foto-di-ms-access/
--- In [email protected], "maneng_lambertus" <maneng_lamber...@...>
wrote:
>
> Halo para pakar visual basic...!
> Saya mohon bantuannya...
> Saya sementara membuat aplikasi Penerimaan siswa di tempat kursus, dan saya
> ingin agar saat pendaftaran harus ada foto (di form Pendaftaran). Dan foto
> yang sudah disimpan di database Access tersebut harus ditampilkan lagi di
> form Profil Siswa. Gimana ya...scriptnya??
> Mohon bantuannya...!! Trima kasih.
>
