scripts to read and write BLOB in MS Access

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 and prepared for a new record.
'
'ARGUMENTS:
'Source - the path and filename of the file to be stored.
'T - the table object to store the data in.
'Field - the OLE object to store the
'RETURN:
'0 on fail 1 on success
'**********************************************************************

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 Byte, RetVal As Variant

On Error GoTo Err_ReadBLOB

SourceFile = FreeFile
Open Source For Binary Access Read As SourceFile
FileLength = LOF(SourceFile)
If FileLength <> 0 Then
NumBlocks = FileLength \ Blocksize
LeftOver = FileLength Mod Blocksize 'remainder appended first
'initialize status bar meter.
RetVal = SysCmd(acSysCmdInitMeter, "Reading BLOB", FileLength \ 1000)
ReDim FileData(LeftOver)
Get SourceFile, , FileData()
T(sField).AppendChunk FileData() 'store the first image chunk
RetVal = SysCmd(acSysCmdUpdateMeter, LeftOver / 1000)
ReDim FileData(Blocksize)
For i = 1 To NumBlocks
Get SourceFile, , FileData()
T(sField).AppendChunk FileData() 'remaining chunks
'update status bar meter
RetVal = SysCmd(acSysCmdUpdateMeter, Blocksize * i / 1000)
Next i
'remove status bar meter
RetVal = SysCmd(acSysCmdRemoveMeter)
End If
Close SourceFile
ReadBLOB = 1
Exit Function

Err_ReadBLOB:
MsgBox Err.Description
ReadBLOB = 0
Exit Function

End Function

'**********************************************************************
'FUNCTION: WriteBLOB()
'
'PURPOSE:
'WritesBLOB information stored in the specified table and field to the
'specified disk file.
'
'PREREQUISITES:
'
'ARGUMENTS:
'Destination - the path and filename of the file to be extracted.
'T - the table object the data is stored in.
'Field - the OLE object to store the data in.
'
'RETURN:
'0 on fail 1 on success
'**********************************************************************

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 Byte, RetVal As Variant

On Error GoTo Err_WriteBLOB

' Get the length of the file.
FileLength = T(sField).ActualSize()
If FileLength <> 0 Then
DestFile = FreeFile
NumBlocks = FileLength \ Blocksize
LeftOver = FileLength Mod Blocksize 'reminder appended first
'initialize status bar meter
RetVal = SysCmd(acSysCmdInitMeter, "Writing BLOB", NumBlocks)
Open Destination For Binary Access Write Lock Write As DestFile
ReDim FileData(LeftOver)
FileData() = T(sField).GetChunk(LeftOver)
Put DestFile, , FileData() 'write first chunk
ReDim FileData(Blocksize)
For i = 1 To NumBlocks
FileData() = T(sField).GetChunk(Blocksize)
Put DestFile, , FileData() 'write remaining chunks
'update status bar meter
RetVal = SysCmd(acSysCmdUpdateMeter, i)
Next i
Close DestFile
End If
'remove status bar meter
RetVal = SysCmd(acSysCmdRemoveMeter)
WriteBLOB = 1
Exit Function

Err_WriteBLOB:
MsgBox Err.Description
WriteBLOB = 0
Exit Function

End Function



Sub test()

Dim Cnn As ADODB.Connection
Dim Rst As ADODB.Recordset
Set Cnn = New ADODB.Connection
Cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; " & "Data Source=E:\PWP Program\Task C Data Conversion\C.3 Power DC\Perform Full Data Conversion\Area2\PWP_Electric_2_test.mdb"
Cnn.Open
'Cnn.Execute ("SELECT CONFIGURATION FROM ConduitSection WHERE OBJECTID=78723;")

'Open a recordest based on the open connection
' Set Rst = New ADODB.Recordset

' Set Rst.ActiveConnection = Cnn
Set Rst = Cnn.Execute("SELECT CONFIGURATION FROM ConduitSection WHERE OBJECTID=78723;")
Rst.MoveFirst
MsgBox Rst.RecordCount

WriteBLOB Rst, "CONFIGURATION", "C:\testblog"

End Sub