how to save and load images to and from a database

Option Explicit

Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long

'Purpose : Saves pictures in image boxes (or similiar) to a field in a recordset
'Inputs : oPictureControl A control containing an image
' adoRS ADO recordset to add the image to
' sFieldName The field name in adoRS, to add the image to
'Outputs : Returns True if succeeded in updating the recordset
'Notes : The field specified in sFieldName, must have a binary field type (ie. OLE Object in access)
' Save the image at the currect cursor location in the recordset.
'Revisions :

Public Function SavePictureToDB(oPictureControl As Object, adoRS As ADODB.Recordset, sFieldName As String) As Boolean
Dim oPict As StdPicture
Dim sDir As String, sTempFile As String
Dim iFileNum As Integer
Dim lFileLength As Long
Dim abBytes() As Byte
Dim iCtr As Integer

On Error GoTo ErrHandler

Set oPict = oPictureControl.Picture
If oPict Is Nothing Then
SavePictureToDB = False
Exit Function
End If

'Save picture to temp file
sTempFile = FileGetTempName
SavePicture oPict, sTempFile

'read file contents to byte array
iFileNum = FreeFile
Open sTempFile For Binary Access Read As #iFileNum
lFileLength = LOF(iFileNum)
ReDim abBytes(lFileLength)
Get #iFileNum, , abBytes()
'put byte array contents into db field
adoRS.Fields(sFieldName).AppendChunk abBytes()
Close #iFileNum

'Don't return false if file can't be deleted
On Error Resume Next
Kill sTempFile
SavePictureToDB = True
Exit Function

ErrHandler:
SavePictureToDB = False
Debug.Print Err.Description
End Function


'Purpose : Loads a Picture, saved as binary data in a database, from a recordset into a picture control.
'Inputs : oPictureControl A control to load the image into
' adoRS ADO recordset to add the image to
' sFieldName The field name in adoRS, to add the image to
'Outputs : Returns True if succeeded in loading the image
'Notes : Loads the image at the currect cursor location in the recordset.


Public Function LoadPictureFromDB(oPictureControl As Object, adoRS As ADODB.Recordset, sFieldName As String) As Boolean
Dim oPict As StdPicture
Dim sDir As String
Dim sTempFile As String
Dim iFileNum As Integer
Dim lFileLength As Long
Dim abBytes() As Byte
Dim iCtr As Integer

On Error GoTo ErrHandler
sTempFile = FileGetTempName

iFileNum = FreeFile
Open sTempFile For Binary As #iFileNum
lFileLength = LenB(adoRS(sFieldName))

abBytes = adoRS(sFieldName).GetChunk(lFileLength)
Put #iFileNum, , abBytes()
Close #iFileNum

oPictureControl.Picture = LoadPicture(sTempFile)

Kill sTempFile
LoadPictureFromDB = True
Exit Function

ErrHandler:
LoadPictureFromDB = False
Debug.Print Err.Description
End Function


'Purpose : The FileGetTempName function returns a name of a temporary file.
'Inputs : [sFilePrefix] The prefix of the file name.
'Outputs : Returns the name of the next free temporary file name (and path).
'Notes : The filename is the concatenation of specified path and prefix strings,
' a hexadecimal string formed from a specified integer, and the .TMP extension


Function FileGetTempName(Optional sFilePrefix As String = "TMP") As String
Dim sTemp As String * 260, lngLen As Long
Static ssTempPath As String

If LenB(ssTempPath) = 0 Then
'Get the temporary path
lngLen = GetTempPath(260, sTemp)
'strip the rest of the buffer
ssTempPath = Left$(sTemp, lngLen)
If Right$(ssTempPath, 1) <> "\" Then
ssTempPath = ssTempPath & "\"
End If
End If

'Get a temporary filename
lngLen = GetTempFileName(ssTempPath, sFilePrefix, 0, sTemp)
'Remove all the unnecessary chr$(0)'s
FileGetTempName = Left$(sTemp, InStr(1, sTemp, Chr$(0)) - 1)
End Function


'SAMPLE USAGE
'NOTE : Add a PictureBox control to a form before running this code
Sub TestLoadPicture()
Dim sConn As String
Dim oConn As New ADODB.Connection
Dim oRs As New ADODB.Recordset

On Error GoTo ErrFailed
sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\MyDb.MDB;Persist Security Info=False"

oConn.Open sConn
oRs.Open "SELECT * FROM MyTable", oConn, adOpenKeyset, adLockOptimistic
If oRs.EOF = False Then
LoadPictureFromDB Picture1, oRs, "MyFieldName"
End If
oRs.Close
Exit Sub
ErrFailed:
MsgBox "Error " & Err.Description
End Sub

'SAMPLE USAGE
'NOTE : Add a PictureBox control to a form before running this code
Sub TestSavePicture()
Dim sConn As String
Dim oConn As New ADODB.Connection
Dim oRs As New ADODB.Recordset

On Error GoTo ErrFailed
sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\MyDb.MDB;Persist Security Info=False"

oConn.Open sConn
oRs.Open "SELECT * FROM MYTABLE", oConn, adOpenKeyset, adLockOptimistic
If oRs.EOF = False Then
oRs.AddNew
SavePictureToDB Picture1, oRs, "MYFIELD"
oRs.Update
End If
oRs.Close
Exit Sub
ErrFailed:
MsgBox "Error " & Err.Description
End Sub