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?

-EDIT-

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

-END EDIT-

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

Answers: