How to save an Access OLE Object (BLOB) image to disk using VBA
So I seem to be able to save BLOB files from Access okay using the code below (which I found while searching how to export a BLOB). But it doesn't seem to be saving a valid .png file. When I try to open the file from disk I get the error "Windows Photo Viewer can't open this picture because the file is appears to be damaged, corrupted, or is too large. I know it's not too large because it's only 1.19MB. Is there a special way you have to write the BLOB file to disk that makes it readable or is there something else that I'm missing?
Taking Gord's advice, I have got the code below using an ADODB.Stream. Unfortunately, I'm still running into the same problem where the file this writes to does not open in windows picture viewer. I'm wondering if this is because of the file extension I am giving it, but I've tried writing to a .JPG file (the default snipping tool save option which is where I expect the pictures to be input from) as well as .png (the file type I want) and .gif. Any ideas would be helpful as to how to solve this problem.
Public Sub TestBlobStream() Dim mStream As New ADODB.Stream Dim rs As RecordSet Set rs = dbLocal.OpenRecordset("BlobTest") Set mStream = New ADODB.Stream mStream.Type = adTypeBinary mStream.Open mStream.Write rs("testBlob") mStream.SetEOS mStream.SaveToFile "D:\Target\TestPic.png", adSaveCreateOverWrite mStream.Close End Sub
Code referenced in original part of question:
Public Sub TestBlob() Dim rs As RecordSet
Set rs = dbLocal.OpenRecordset("BlobTest") DBug WriteBLOB(rs, "testBlob", "D:\Target\TestPic.png") Set rs = Nothing End Sub Function WriteBLOB(T As DAO.RecordSet, sField As String, Destination As String) Dim NumBlocks As Long, DestFile As Long, i As Long Dim FileLength As Long, LeftOver As Long Dim FileData As String Dim RetVal As Variant ' 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, _ "Writing BLOB", 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 End Function