Export blob OLE Object Field Item instead of Attachment Field

[UnionWarDog]

Hi guys,

I have a code to extract the Attachment field of a table but would rather extract the OLE Object field. How can I change the script to pull the OLE Object ([Image]) instead of the Attachment field ([GenImage]). Here is table data:

LeadersDBList

ID	STATE	Size	Utype	GenSide	NationFolder	Unit Name	UnitCard	Image	GenImage
1	Bulgarian	Department	Leader	Rebel Genearl	Bulgarian	Department Nr. 2	Gen Albert S. Johnston	BitmapImage	@(1)

Here is the code:

Public Sub ExtractAllAttachments(ByVal TableName As String, ByVal AttachmentColumnName As String, ByVal ToDirectory)

Const cNEW_FILE_FIELD As String = "[UnitCard]"

Dim rsMainRecords As DAO.Recordset2
Dim rsAttachments As DAO.Recordset2
Dim outputFileName As String
Dim NewFile As String

Set rsMainRecords = CurrentDb.OpenRecordset("SELECT " & AttachmentColumnName & ", " & cNEW_FILE_FIELD & _
" FROM " & TableName & _
" WHERE " & AttachmentColumnName & ".FileName IS NOT NULL")

Do Until rsMainRecords.EOF

    Set rsAttachments = rsMainRecords.Fields(AttachmentColumnName).Value
 
    Do Until rsAttachments.EOF
 
   
        outputFileName = rsAttachments.Fields("FileName").Value
        NewFile = Trim$(rsMainRecords.Fields(1) & "")
        If Len(NewFile) <> 0 Then
            NewFile = NewFile & ExtensionOfFile(outputFileName)
        Else
            NewFile = outputFileName
        End If
       
        outputFileName = ToDirectory & "\" & NewFile

       'delerte old image
       If Len(Dir$(outputFileName))<>0 then
             Kill outputFileName
      End If
   
        rsAttachments.Fields("FileData").SaveToFile outputFileName
   
        rsAttachments.MoveNext
    Loop
 
    rsAttachments.Close
    rsMainRecords.MoveNext
Loop

rsMainRecords.Close

Set rsAttachments = Nothing
Set rsMainRecords = Nothing

End Sub

 

[jdraw]

The code below should help in adjusting your procedure to extract OLE/Blob field/data and place it in a jpg file on the file system with a name based on your table.
This does extract the blobField data in my tblBlobTest to a jpg file on the file system.

Sample execution call with associated immediate window info:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Call ExtractAllBLOBS("tblBlobtest","BlobField","c:\users\jp\downloads\","filename")
Number of records to process: 4
writing c:\users\jp\downloads\KillThis_Account.jpg
writing c:\users\jp\downloads\KillThis_HittingGo.jpg
writing c:\users\jp\downloads\KillThis_SeparatorMsg.jpg
writing c:\users\jp\downloads\KillThis_RacoonJack.jpg
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'My test table
'-- tblBlobTest (3 fields)--
'recID  autonumber pk
'blobField ole
'fileName string

'''Revised from Attachment to Blob/ole

' ----------------------------------------------------------------
' Procedure Name: ExtractAllBLOBS
' Purpose: Extract OLE/blob data from table to a jpg file on filesystem
' Procedure Kind: Sub
' Procedure Access: Public
' Parameter TableName (String): name of table with the OLE/blob field
' Parameter BLOBColumnName (String): name of the OLE/blob file in the table
' Parameter ToDirectory (): directory name where extrcted OLE/blob will reside
' Parameter NewFileName (String): name from your table to be used as part of extracted jpg file name
' Author: Jack
' Date: 15-Mar-25
' ----------------------------------------------------------------
Public Sub ExtractAllBLOBS(ByVal TableName As String, ByVal BLOBColumnName As String, _
                            ByVal ToDirectory, NewFileName As String)
      'newFilename is a field in your table to be used as part of the extracted jpg file name
          
          Const myPrefix As String = "KillThis_"  'prefix to identify my new extracted ole tests

          Dim db As DAO.Database
          Dim rs As DAO.Recordset
          Dim fld As DAO.Field
          Dim rNum As String
          Dim FName As String
          Dim ext As String
          Dim strFilePath As String
          Dim intFileNum As Integer
          Dim byteData() As Byte
          Dim SQL As String
          Dim FullOutputFile As String
                    
          ' Set up the database and recordset to select the proper OLe/blobs
10        Set db = CurrentDb
20        SQL = "SELECT " & NewFileName & " , " & BLOBColumnName & " FROM " & TableName _
              & " WHERE " & BLOBColumnName & " is not null;"
         ' Debug.Print SQL
30        Set rs = db.OpenRecordset(SQL)
40        rs.MoveLast
50        Debug.Print "Number of records to process: " & rs.recordCount
60        rs.MoveFirst

          '         Extract each qualifying ole/blob field from table to FullOutputFile
70        Do While Not rs.EOF
            
80            Set fld = rs(BLOBColumnName)
90            rNum = myPrefix    '             is my prefix to identify test files for deletion
100           FName = rs(NewFileName)
110           ext = "jpg"
       
          'construct fullOutputFile name
120         FullOutputFile = ToDirectory & rNum & FName & "." & ext

              ' Read the binary data
130           byteData = fld.Value

              ' Write the binary data to a file
140           intFileNum = FreeFile
150           Open FullOutputFile For Binary As #intFileNum
160           Put #intFileNum, , byteData
170           Debug.Print "writing " & FullOutputFile
180           Close #intFileNum
190           MsgBox "Image extracted successfully as " & FullOutputFile, vbInformation
200           rs.MoveNext
                
210       Loop
          
          ' Clean up
220       rs.Close
230       Set rs = Nothing
240       Set db = Nothing
          
250       On Error GoTo 0
ExtractBlobImage_Exit:
260       Exit Sub

ExtractBlobImage_Error:

270       MsgBox "Error " & Err.Number & " (" & Err.Description & "), line " & Erl & " in Procedure ExtractBlobImage" _
              & "  Module  BLOBStuff "
280       GoTo ExtractBlobImage_Exit
End Sub

 

[UnionWarDog]

Hi jdraw! Thanks for the info!! I made basic table as mentioned and pasted the code in the module but got the below debug message:

Run-time error '75: Path/File access error

Debug stops at: 150 Open FullOutputFile For Binary As #intFileNum

The table I made was:
tblBlobTest

recID	blobField	fileName
1	Bitmap Image	SuppliesIcon

My immediate window was:
ExtractAllBLOBS "tblBlobTest","blobField","E:\TempImages","fileName"


I created 1 file line to test but got the run-time error.

Best regards!, UnionWarDog

 

[UnionWarDog]

Hi jdraw, I changed the immediate window to Call ExtractAllBLOBS("tblBlobtest","BlobField","E:\TempImages\","filename") and was able to extract the file but the extracted image says it's an unknow format. I tried a .jpg, jpeg and .bmp file and they all say they are unknow formats.

Good news, the extraction works! Bad news is the file format isn't working.

 

[arnelgp]

Extracting OLE Object is more challenging on newer OS/Access than before.
since Access is adding extra data in front of the actual picture data being saved
on the field, you need to first determine and eliminate those data and just
extract the picture data of the image. Only access knows the Length of such
"padding".

 

[jdraw]

UWD,

Do you know what format your blob was in when you loaded it in your database? I did my testing with jpg. I had to work with the Put statement to get the the extracted jpg to render properly. My earlier code resulted in error when trying to display the extracted jpg. This latest code works with a variety of my test jpg files.
Note: I created my test blob/ole fields using jpg files, and the extraction code works specifically with jpg.

You don't need a separate table and data -- however that i good for testing/adjusting the code.
The ExtractAllBLOBS routine should work with your table providing you are dealing with jpg images. I set it up to deal with any table where there was a blob (based on jpg) and extracting from that table to a directory of your choosing and part of the extracted filename to be based on a field value from the record where the blob/OLE is stored.

Re Error 75, did you confirm that your path exists?

If you can post a small database with some of your data, I'll do some testing/experimenting to see if I can help. I'm interested in the blob/image/OLE data in your table. Sounds like it isn't jpg.

Update: I did create a small routine to determine the type of image file.
(jpg, psd, png, bmp, tiff, gif, svg, webp, heic)
Sample output with test data:

ReviewFilesInDirectory "c:\users\jp\pictures\testformats\"
1  Processing File: c:\users\jp\pictures\testformats\11473277.psd
c:\users\jp\pictures\testformats\11473277.psd is a PSD
2  Processing File: c:\users\jp\pictures\testformats\BugMaterialAntibiotic.JPG
c:\users\jp\pictures\testformats\BugMaterialAntibiotic.JPG is a JPG
3  Processing File: c:\users\jp\pictures\testformats\CatCoon.PNG
c:\users\jp\pictures\testformats\CatCoon.PNG is a PNG
4  Processing File: c:\users\jp\pictures\testformats\chevyexpress.bmp
c:\users\jp\pictures\testformats\chevyexpress.bmp is a BMP
5  Processing File: c:\users\jp\pictures\testformats\EricRevised1.gif
c:\users\jp\pictures\testformats\EricRevised1.gif is a GIF
6  Processing File: c:\users\jp\pictures\testformats\f150a.bmp
c:\users\jp\pictures\testformats\f150a.bmp is a BMP
7  Processing File: c:\users\jp\pictures\testformats\MultiMap.png
c:\users\jp\pictures\testformats\MultiMap.png is a PNG
8  Processing File: c:\users\jp\pictures\testformats\sample-4.webp
c:\users\jp\pictures\testformats\sample-4.webp is a WEBP
9  Processing File: c:\users\jp\pictures\testformats\sample1.heic
c:\users\jp\pictures\testformats\sample1.heic is a HEIC/HEIF
10  Processing File: c:\users\jp\pictures\testformats\sample_640×426.tiff
c:\users\jp\pictures\testformats\sample_640×426.tiff is a TIFF
11  Processing File: c:\users\jp\pictures\testformats\sample_SVG_117KB.svg
c:\users\jp\pictures\testformats\sample_SVG_117KB.svg is a SVG
12  Processing File: c:\users\jp\pictures\testformats\tigerRiver.jpg
c:\users\jp\pictures\testformats\tigerRiver.jpg is a JPG

 

[arnelgp]

on Newer OS (Win11) and Access 2021, I successfully extract image from OLEObject (as Package on my OleObject field).
atm, it can only extract jpg, bmp, ico and png.
the extracted image is viewable.

as suggested, post a sample table with Blob field (with image on it).

 

[arnelgp]

Update: I did create a small routine to determine the type of image file.
(jpg, psd, png, bmp, tiff, gif, svg, webp, heic)
Sample output with test data:

if you are only determining the file type based on the extension, then
it is not accurate. anybody can rename the extension of a file.

what is accurate is the code on examining the file header signature
with the code found here:

Using VBA to Identify File Types Using Their File Signatures

Demonstrating how we can use plain vanilla VBA to read files and properly identify their file type based on the file's signature.

www.devhut.net

i am using such function to extract the image data, plus other functions.

 

[jdraw]

arnel,
I am checking file header, but have found some issues (heic and ico)
I'll check Daniel's article. Thanks

 

[jdraw]

I used the following code to review headers in some image files.

' ----------------------------------------------------------------
' Procedure Name: DetectImageFileType
' Purpose: Determine Image File Type based on the file header data from a
'          blob/ole field in a table or file on file system.
'          Tested with/for jpg, png, ico, psd, gif, bmp, svg, heic, tiff
' Procedure Kind: Function
' Procedure Access: Public
' Parameter fileHeader (String): FileHeader is the signature (Bytes from file) for various image file types.
' Return Type: String
' Author: Jack
' Date: 17-Mar-25
' ----------------------------------------------------------------
Function DetectImageFileType(fileHeader As String) As String
    ' Determine the file type based on the header
    Select Case True
        Case Left(fileHeader, 4) = "FFD8":   DetectImageFileType = "JPG"
        Case Left(fileHeader, 8) = "38425053": DetectImageFileType = "PSD"
        Case Left(fileHeader, 8) = "89504E47": DetectImageFileType = "PNG"
        Case Left(fileHeader, 4) = "424D": DetectImageFileType = "BMP"
        Case Left(fileHeader, 4) = "4949" Or Left(fileHeader, 4) = "4D4D"
                                          DetectImageFileType = "TIFF"
        Case Left(fileHeader, 8) = "47494638": DetectImageFileType = "GIF"
        Case Left(fileHeader, 12) = "3C3F786D6C20": DetectImageFileType = "SVG"
        Case Left(fileHeader, 8) = "52494646": DetectImageFileType = "WEBP"
        Case Mid(fileHeader, 6, 8) = "66747970" And Mid(fileHeader, 34, 8) = "68656963"
                                           DetectImageFileType = "HEIC"
        Case Left(fileHeader, 6) = "001010": DetectImageFileType = "ICO"
        Case Else: DetectImageFileType = "Unknown"
    End Select
    
End Function