Ok, so I am doing a lot of Access for a friend. And I got into a problem that I was sure had a simple solution somewhere. Apparently it does not. The documentation for the issue is either not existant or buggy and the "helping" comments usually are trying to tell you you are wrong without trying to give a workable solution or directing you to some commercial solution. So this is for the people trying to solve the following problem:
You have images embedded in an Ole Object field in a table, the images are jpg or whatever format and they appear to the table editor as Package and you want to display those images in an Image control in an Access Form via VB, without binding anything. Also, I am using Access 2007.
The first thing you are going to find when googling is that putting images in the database is a bad idea. Whenever you see this, close the page. People will give you their solution, which is store the URL of the image in the database. We don't want that, for various reasons.
After googling some more, you will find there is no solution involving the Image control, but rather only Bound or Unbound Ole Object Frames. We don't want that either.
The only solution left, since
the Image control does not support direct content, but only a path to an image, is to read the binary data from the field, store it in a temporary file, then display it. When looking for this
you will get to a Microsoft knowledge base article, which does most of the work, but is buggy! You see, the
FileData variable they use in the
WriteBLOB function is defined as a string, and it should be defined as a byte array.
Also, you want to retrieve the data from the record as binary data and so you want to use
CurrentDb.OpenRecordset("MyQuery") and you get a stupid error like "
Run-time error '3061': Too few parameters. Expected 1.". This is because your query has a form parameter and it just fails. There are some solutions for this, but what I basically did was to read the ID of the record in a variable using normal DLookup, then write a new SQL query inline:
CurrentDb.OpenRecordset("SELECT Picture FROM MyTable WHERE ID=" & id).
When you finally make it to save the binary data in a file, you notice that
the file is not what you wanted, instead it is a little bigger and starts with some mambo jumbo containing the word
Package again. That means that,
in order to get the file we want, you need to decode the OLE package format.
And here is where I come from, with the following code:
' Declarations that should go at the beginning of your code file
' ==========================
Const BlockSize = 32768
Const UNIQUE_NAME = &H0
Private Declare Function GetTempPathA Lib "kernel32" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function GetTempFileNameA Lib "kernel32" _
(ByVal lpszPath As String, ByVal lpPrefixString As String, _
ByVal wUnique As Long, ByVal lpTempFileName As String) _
As Long
' ==========================
' Get a temporary file name
Public Function GetTempFileName() As String
Dim sTmp As String
Dim sTmp2 As String
sTmp2 = GetTempPath
sTmp = Space(Len(sTmp2) + 256)
Call GetTempFileNameA(sTmp2, "", UNIQUE_NAME, sTmp)
GetTempFileName = Left$(sTmp, InStr(sTmp, Chr$(0)) - 1)
End Function
' Get a temporary file path in the temporary files folder
Private Function GetTempPath() As String
Dim sTmp As String
Dim i As Integer
i = GetTempPathA(0, "")
sTmp = Space(i)
Call GetTempPathA(i, sTmp)
GetTempPath = AddBackslash(Left$(sTmp, i - 1))
End Function
' Add a trailing backslash is not already there
Private Function AddBackslash(s As String) As String
If Len(s) > 0 Then
If Right$(s, 1) <> "\" Then
AddBackslash = s + "\"
Else
AddBackslash = s
End If
Else
AddBackslash = "\"
End If
End Function
' Write binary data from a recordset into a temporary file and return the file name
Function WriteBLOBToFile(T As DAO.Recordset, sField As String)
Dim NumBlocks As Integer, DestFile As Integer, i As Integer
Dim FileLength As Long, LeftOver As Long
Dim FileData() As Byte
Dim RetVal As Variant
On Error GoTo Err_WriteBLOB
' Get the size of the field.
FileLength = T(sField).FieldSize()
If FileLength = 0 Then
WriteBLOBToFile = Null
Exit Function
End If
'read Package format
Dim pos As Integer
pos = 70 ' Go to position 70
Do ' read a string that ends in a 0 byte
FileData = T(sField).GetChunk(pos, 1)
pos = pos + 1
Loop Until FileData(0) = 0
Do ' read a string that ends in a 0 byte
FileData = T(sField).GetChunk(pos, 1)
pos = pos + 1
Loop Until FileData(0) = 0
pos = pos + 8 ' ignore 8 bytes
Do ' read a string that ends in a 0 byte
FileData = T(sField).GetChunk(pos, 1)
pos = pos + 1
Loop Until FileData(0) = 0
' Get the original file size
FileData = T(sField).GetChunk(pos, 4)
FileLength = CLng(FileData(3)) * 256 * 256 * 256 + _
CLng(FileData(2)) * 256 * 256 + _
CLng(FileData(1)) * 256 + CLng(FileData(0))
' Read the original file data from the current position
pos = pos + 4
' Calculate number of blocks to write and leftover bytes.
NumBlocks = FileLength \ BlockSize
LeftOver = FileLength Mod BlockSize
' Get a temporary file name
Dim Destination As String
Destination = GetTempFileName()
' 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, "Writing BLOB", FileLength / 1000)
' Write the leftover data to the output file.
FileData = T(sField).GetChunk(pos, 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(pos + (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
WriteBLOBToFile = Destination
Exit Function
Err_WriteBLOB:
WriteBLOBToFile = Null
Exit Function
End Function
The function is used like this:
Dim id As String
id = DLookup("ID", "MyTableQueryWithFormCriteria", "")
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT Picture FROM MyTable WHERE ID=" & id)
Dim filename As String
filename = Nz(WriteBLOBToFile(rs, "Picture"), "")
imgMyImage.Picture = filename
So,
MyTable is a fictional table that contains an
ID field and a
Picture field of type OLE Object.
MyTableQueryWithFormCriteria is a query used inside the form to get the data for the current form. It contains the
MyTable table and selects at least the
ID field. The
WriteBLOBToFile function creates a temporary file, writes the binary data in the OLE Object field in it and returns the file's filename, so that we can feed it in the Image control.
The trick in the
WriteBLOBToFile function is that, at least in my case with Access 2007, the binary data in the field is stored in a "
Package". After looking at it I have determined that its format is like this:
- A 0x40 (64) byte header
- A 4 byte length
- A 2 byte (version?) field
- A string (characters ended with a 0 byte)
- Another string
- 8 bytes that I cared not to decode
- Another string
- The size of the packaged file (the original) in a 4 byte UInt32
- The data in the original file
- Some other rubbish that I ignored
The function thus goes to 64+6=70, reads 2 strings, moves 8 bytes, reads another string, then reads the length of the data and saves that much from the current position.
The examples in the pages I found said nothing about this except that you need an OLE server for a specific format in order to read the field, etc, but all of them suggested to save the binary data as if it were the original file. Maybe in some cases this happends, or maybe it is related to the version of MS Access.
Stellvia is an anime with teenage kids saving the world. It starts like a kind of Harry Potter, only the main character is a girl, the academy is in space and there are no Voldermort or Slitherins in sight. All in all it was a fun series to watch, but so easy going and adolescent oriented that I am sure it will not remain in my memory for long.
