Saving and Extracting Image to Recordset

jhai_salvador 1 848 Views

Add the snippet in your module.

Requirements:

  • Make sure you have reference to M$ ActiveX Data Objects Library (ADODB)
  • A table field with OLE Object / BLOB as datatype
  • A recordset that is already oppened and ready to be use

To save Image on your table field, call SetRSBlob function

Make sure that your recordset is already loaded or openned

Lets assume that our recordset rs is already oppened and ready to be updated.

Dim ret as Boolean
ret = SetRSBlob("C:\image1.jpg", rs, "image")

TRUE will be returned if image was set to the recordset field.

All you have to do is call recordset rs.update function to save it permanently to the table.

To extract the image, just call the ExtractBlob function

Again, make sure that your recordset is already openned.

Dim ret as Boolean
ret = ExtractBlob(rs, "image", "c:\extracted_image.jpg")

It will return true if image was extracted successfully.

Code is not that clean but I hope anyone can enjoy and learn something on it.

I used this code on my church management software which you can download on my website :) (I hope I will not get banned for posting my site.. haha)

Anyway, enjoy and have a happy coding..

Peace out.. :)

Function SetRSBlob(strFileName As String, dbRecordSet As ADODB.Recordset, OLEFieldName As String) As Boolean
   On Error GoTo hErr
   Dim fH      As Integer
   Dim fLen    As Long
   Dim bytes() As Byte
   fH = FreeFile()
   '* Get File bytes
   Open strFileName For Binary As #fH
      fLen = LOF(fH) - 1
      bytes = InputB(fLen, #fH)
   Close #fH
   '* Set recordset value
   dbRecordSet.Fields(OLEFieldName).Value = bytes
   SetRSBlob = True
   Exit Function
hErr:
   SetRSBlob = False
   Debug.Print Err.Description
End Function

Public Function ExtractBlob(dbRecordSet As ADODB.Recordset, _
                            OLEFieldName As String, _
                            mvarSaveToFileName As String) As Boolean
   Dim fH      As Integer
   Dim bytes() As Byte
   Dim fLen    As Long
   '* if null, exit
   If IsNull2(dbRecordSet.Fields(OLEFieldName).Value) Then
      Exit Function
   End If
   '* check size, if 0 exit
   fLen = dbRecordSet.Fields(OLEFieldName).ActualSize ' Length of data in file
   If fLen = 0 Then
      Exit Function
   End If
   fH = FreeFile()
   '* Get bytes
   bytes = dbRecordSet.Fields(OLEFieldName).Value
   '* If file exist, delete it
   If FileExist(mvarSaveToFileName) Then
      Call Kill2(mvarSaveToFileName)
   End If
   '* Save binary file
   Open mvarSaveToFileName For Binary As #fH
      Put #fH, , bytes
   Close #fH
   '* If file exist, return true
   If FileExist(mvarSaveToFileName) Then
      ExtractBlob = True
   End If
   FileSystem.Reset
End Function

'* Additional codes

'Custom null check, return true if null or string is blank
'tested with string
'tested with recordset field
Private Function IsNull2(Var As Variant) As Boolean
   Dim ret As Boolean
   ret = True
   If Not IsNull(Var) Then
      If CStr(Var) <> "" Then
         ret = False
      End If
   End If
   IsNull2 = ret
End Function

'* check file if exist
Private Function FileExist(FilePath As String) As Boolean
   On Error GoTo ErrorHandler
   Call FileLen(FilePath)
   FileExist = True
   Exit Function
ErrorHandler:
   FileExist = False
End Function

'* Delete file
Public Function Kill2(strFileName As String) As Boolean
   On Error GoTo hErr
   Call Kill(strFileName)
   Kill2 = True
   Exit Function
hErr:
   Kill2 = False
End Function

Dani AI

Generated

Nice, practical functions from — they cover the basic save/extract flow for image BLOBs. A few pragmatic improvements make the routine more robust and easier to maintain: use ADODB.Stream for binary I/O, fix the null/array checks, avoid the LOF off‑by‑one trap, and be aware of Access OLE wrapping and provider limits.

A compact, reliable alternative using ADODB.Stream (requires the ADODB reference):

' Save file into a BLOB field
Dim stm As New ADODB.Stream
stm.Type = adTypeBinary
stm.Open
stm.LoadFromFile "C:\image1.jpg"
rs.Fields("image").Value = stm.Read
stm.Close
rs.Update
' Extract BLOB to disk
Dim stm As New ADODB.Stream
stm.Type = adTypeBinary
stm.Open
stm.Write rs.Fields("image").Value
stm.SaveToFile "C:\extracted_image.jpg", adSaveCreateOverWrite
stm.Close

Key pitfalls and notes:

  • The posted code uses LOF(fH) - 1 which will drop the last byte; using ADODB.Stream avoids that class of error.
  • The custom IsNull2 converts the value to string; that will raise a type mismatch for byte arrays. Prefer checks with IsNull, IsArray and VarType (or a small helper that treats arrays and empty strings distinctly).
  • For very large blobs some providers require AppendChunk/GetChunk or parameterized Command objects instead of assigning a single large Variant. ADODB.Stream plus a parameterized Command is a common pattern.
  • Microsoft Access OLE Object fields frequently add an OLE wrapper when files are inserted via the UI. To store raw image bytes (so extraction yields a usable image file) either write bytes programmatically (as above) or use Access Attachment fields / a varbinary column on server databases.
  • Cursor and lock types matter: an updateable recordset typically needs an updateable cursor and adLockOptimistic for Fields(...).Value = … followed by rs.Update.

These changes preserve the original workflow while improving reliability and making the code friendlier to large files and mixed field types.

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.

Edit Preview