Export pictures from database with code?

[snoopy75]

I've got a bunch of pictures in a database, in an OLE Object field. I want to take all the pictures out and save them as individual image files. Individually, I can do this by double-clicking the picture in the form, which opens it in my image editor, where I can save it.

However, I've got about 500 pictures to do this with, and I'd like to automate the process. Is there any kind of code that will export or save an OLE object to the hard drive? Thanks!

--Ryan

 

[mp9]

This used to work for me in A97 - however, I haven't been able to get it to run in A2000. Let's say you've got a button on the form underneath the OLE object (which I've called objImage). In the button's OnClick event, add:

Me.objImage.Export "c:\temp\image.gif", "GIF", False

You could add file dialogs or use an InputBox beforehand to prompt for a filename.

The image format property ("GIF" in this example) also takes "JPG" or "TIFF" as valid values. The last parameter, if set to True, is supposed to then open the image in your default image editor, but I've never tried that.

If you're using A2000 or above and find a way to make this work, please post it in this thread. Thanx.

Hope this helps.

http://www22.brinkster.com/accessory/

 

[snoopy75]

Alright, that doesn't work. I get the following error message:

Run-Time Error '438':
Object doesn't support this property or method.

I am using Access 97, and I can't find anywhere that says anything about the Export method of a bound image object, or any other kind of object for that matter. Perhaps there's a reference you're using that I don't have... any idea what it could be? Thanks for your response.

--Ryan

 

[mp9]

My mistake, the code I posted works for exporting graphs from reports and forms, but not for the OLE object type you describe.

http://www22.brinkster.com/accessory/

 

[snoopy75]

Thanks anyway. So... anyone else have any ideas?

--Ryan

 

[snoopy75]

Nothing? I can't have stumped everyone...

--Ryan

 

[connermacleod]

Hi snoopy75,

I had the same problem (about 300 jpg pictures from my students had grown my dB to 820 M). So yesterday I've written a small script which reads the pictures prom the screen (Ctrl+c) starts mspaint, creates a new picture and then saves the picture to the harddisk. After that I've read the jpg files as BLOB objects in my database. Now it has only 18 M. Now hopefully I can show this BLOB objects to my forms (with saving the BLOB object to disk and then creating a link to that file)

Will post the code later.

 

[connermacleod]

Here is the promised code

Private Sub cmdExportPictures_Click()

' Exports all OLE Pictures to files via MSPAINT
' and keystrokes.
' The original pictures have been dragged and dropped to
' the table to the corresponding matricule (=ID).

On Error GoTo Err_Export_Click
DoCmd.GoToRecord , , acFirst


Dim Matricule As String
Dim ReturnValue
Matricule = "AVALUE"
While Matricule <> &quot;&quot;
Forms!FormElevesImportExportPictures!Matricule.SetFocus
Matricule = Me!Matricule.Text

Forms!FormElevesImportExportPictures!Image.SetFocus
SendKeys &quot;^(c)&quot;, True

ReturnValue = Shell(&quot;MSPAINT.EXE&quot;, 1)
SendKeys &quot;^(v)&quot;, True
SendKeys &quot;{ENTER}&quot;, True
SendKeys &quot;%fs&quot;, True
SendKeys Matricule, True
SendKeys &quot;{Tab}&quot;, True
SendKeys &quot;{DOWN}&quot;, True
SendKeys &quot;{DOWN}&quot;, True
SendKeys &quot;{DOWN}&quot;, True
SendKeys &quot;%s&quot;, True

SendKeys &quot;%{F4}&quot;, True ' Send ALT+F4 to close paint

DoCmd.GoToRecord , , acNext
Wend

Exit_Export_Click:
Exit Sub

Err_Export_Click:
MsgBox Err.Description
Resume Exit_Export_Click


End Sub


Private Sub cmdImport_Click()

' Import Pictures to corresponding Matricules
Dim Matricule As String
Dim Source As String
Dim ReturnValue

Dim BytesRead As Variant, BytesWritten As Variant
Dim Msg As String
Dim db As Database
Dim rstTemp As Recordset

DoCmd.GoToRecord , , acFirst

Matricule = &quot;AVALUE&quot;
While Matricule <> &quot;&quot;
Forms!FormElevesImportExportPictures!Matricule.SetFocus
Matricule = Me!Matricule.Text
' DoCmd.GoToRecord , , acNext

Source = &quot;C:\Documents and Settings\Administrator\My Documents\My Pictures\&quot; & Matricule & &quot;.JPG&quot;

' Open the BLOB table.
Set db = CurrentDb()
Set rstTemp = db.OpenRecordset _
(&quot;SELECT * FROM tblEleves WHERE Matricule='&quot; & Matricule & &quot;'&quot;, dbOpenDynaset, dbOptimistic)

ReturnValue = ReadBLOB(Source, rstTemp, &quot;Image&quot

Forms!FormElevesImportExportPictures!Image.SetFocus

DoCmd.GoToRecord , , acNext
Wend
End Sub

Option Compare Database
Const BlockSize = 32768


'**************************************************************
' FUNCTION: ReadBLOB()
'
' PURPOSE:
' Reads a BLOB from a disk file and stores the contents in the
' specified table and field.
'
' PREREQUISITES:
' The specified table with the OLE object field to contain the
' binary data must be opened in Visual Basic code (Access Basic
' code in Microsoft Access 2.0 and earlier) and the correct record
' navigated to prior to calling the ReadBLOB() function.
'
' ARGUMENTS:
' Source - The path and filename of the binary information
' to be read and stored.
' T - The table object to store the data in.
' Field - The OLE object field in table T to store the data in.
'
' RETURN:
' The number of bytes read from the Source file.
'**************************************************************
Public Function ReadBLOB(Source As String, T As Recordset, sField As String)
Dim NumBlocks As Integer, SourceFile As Integer, i As Integer
Dim FileLength As Long, LeftOver As Long
Dim FileData As String
Dim RetVal As Variant

On Error GoTo Err_ReadBLOB

' Open the source file.
SourceFile = FreeFile
Open Source For Binary Access Read As SourceFile

' Get the length of the file.
FileLength = LOF(SourceFile)
If FileLength = 0 Then
ReadBLOB = 0
Exit Function
End If

' Calculate the number of blocks to read and leftover bytes.
NumBlocks = FileLength \ BlockSize
LeftOver = FileLength Mod BlockSize

' SysCmd is used to manipulate status bar meter.
RetVal = SysCmd(acSysCmdInitMeter, &quot;Reading BLOB&quot;, FileLength \ 1000)

' Put the record in edit mode.
T.Edit

' Read the leftover data, writing it to the table.
FileData = String$(LeftOver, 32)
Get SourceFile, , FileData
T(sField).AppendChunk (FileData)

RetVal = SysCmd(acSysCmdUpdateMeter, LeftOver / 1000)

' Read the remaining blocks of data, writing them to the table.
FileData = String$(BlockSize, 32)
For i = 1 To NumBlocks
Get SourceFile, , FileData
T(sField).AppendChunk (FileData)

RetVal = SysCmd(acSysCmdUpdateMeter, BlockSize * i / 1000)
Next i

' Update the record and terminate function.
T.Update
RetVal = SysCmd(acSysCmdRemoveMeter)
Close SourceFile
ReadBLOB = FileLength
Exit Function

Err_ReadBLOB:
ReadBLOB = -Err
Exit Function

End Function

'**************************************************************
' FUNCTION: WriteBLOB()
'
' PURPOSE:
' Writes BLOB information stored in the specified table and field
' to the specified disk file.
'
' PREREQUISITES:
' The specified table with the OLE object field containing the
' binary data must be opened in Visual Basic code (Access Basic
' code in Microsoft Access 2.0 or earlier) and the correct
' record navigated to prior to calling the WriteBLOB() function.
'
' ARGUMENTS:
' T - The table object containing the binary information.
' sField - The OLE object field in table T containing the
' binary information to write.
' Destination - The path and filename to write the binary
' information to.
'
' RETURN:
' The number of bytes written to the destination file.
'**************************************************************
Public Function WriteBLOB(T As Recordset, sField As String, Destination As String)
Dim NumBlocks As Integer, DestFile As Integer, i As Integer
Dim FileLength As Long, LeftOver As Long
Dim FileData As String
Dim RetVal As Variant

On Error GoTo Err_WriteBLOB

' Get the size of the field.
FileLength = T(sField).FieldSize()
If FileLength = 0 Then
WriteBLOB = 0
Exit Function
End If

' Calculate number of blocks to write and leftover bytes.
NumBlocks = FileLength \ BlockSize
LeftOver = FileLength Mod BlockSize

' Remove any existing destination file.
DestFile = FreeFile
Open Destination For Output As DestFile
Close DestFile

' Open the destination file.
Open Destination For Binary As DestFile

' SysCmd is used to manipulate the status bar meter.
RetVal = SysCmd(acSysCmdInitMeter, _
&quot;Writing BLOB&quot;, FileLength / 1000)

' Write the leftover data to the output file.
FileData = T(sField).GetChunk(0, LeftOver)
Put DestFile, , FileData

' Update the status bar meter.
RetVal = SysCmd(acSysCmdUpdateMeter, LeftOver / 1000)

' Write the remaining blocks of data to the output file.
For i = 1 To NumBlocks
' Reads a chunk and writes it to output file.
FileData = T(sField).GetChunk((i - 1) * BlockSize _
+ LeftOver, BlockSize)
Put DestFile, , FileData

RetVal = SysCmd(acSysCmdUpdateMeter, _
((i - 1) * BlockSize + LeftOver) / 1000)
Next i

' Terminates function
RetVal = SysCmd(acSysCmdRemoveMeter)
Close DestFile
WriteBLOB = FileLength
Exit Function

Err_WriteBLOB:
WriteBLOB = -Err
Exit Function

End Function


Private Sub Form_Current()
' Show picture from BLOB Object from db
Dim db As Database
Dim rst As Recordset

Dim strFilterRecords As String
Dim strMatricule As String
Dim ReturnValue
Dim TempDir, TempFileName As String

Dim ByteData() As Byte 'Byte array for picture file.

TempDir = Environ(&quot;Temp&quot

Set db = CurrentDb()
Me!Matricule.SetFocus
strMatricule = Me!Matricule.Text

strFilterRecords = &quot;SELECT Image FROM tblEleves&quot; _
& &quot; WHERE tblEleves.Matricule Like &quot;&quot;&quot; & strMatricule & &quot;*&quot;&quot; &quot;

' Open the BLOB table.
Set db = CurrentDb()
Set rst = db.OpenRecordset(strFilterRecords, dbOpenSnapshot)

TempFileName = TempDir & &quot;\&quot; & strMatricule & &quot;.jpg&quot;

ReturnValue = BLOB.WriteBLOB(rst, &quot;Image&quot;, TempFileName)

Me!Image.Visible = True
Me!Image.Picture = TempFileName
Kill TempFileName

End Sub