Const BlockSize = 32768
' 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 code and the correct record navigated to prior to calling the ReadBLOB() function.
Function ReadBLOB(strSource As String, rstData As Recordset, strField As String) As Long
Dim intNumBlocks As Integer
Dim intSourceFile As Integer
Dim i As Integer
Dim lngFileLength As Long
Dim lngLeftOver As Long
Dim strFileData As String
Dim varRetVal As Variant
On Error GoTo Err_ReadBLOB
' Open the strSource file.
10: intSourceFile = FreeFile
20: Open strSource For Binary Access Read As intSourceFile
' Get the length of the file.
30: lngFileLength = LOF(intSourceFile)
40: If lngFileLength = 0 Then
50: ReadBLOB = 0
60: Exit Function
70: End If
' Calculate the number of blocks to read and leftover bytes.
80: intNumBlocks = lngFileLength \ BlockSize
90: lngLeftOver = lngFileLength Mod BlockSize
' SysCmd is used to manipulate status bar meter.
100: varRetVal = SysCmd(acSysCmdInitMeter, "Reading BLOB", lngFileLength \ 1000)
' Put the record in edit mode.
110: rstData.Edit
' Read the leftover data, writing it to the table.
120: strFileData = String$(lngLeftOver, 32)
130: Get intSourceFile, , strFileData
140: rstData.Fields(strField).AppendChunk strFileData
150: varRetVal = SysCmd(acSysCmdUpdateMeter, lngLeftOver / 1000)
' Read the remaining blocks of data, writing them to the table.
160: strFileData = String$(BlockSize, 32)
170: For i = 1 To intNumBlocks
180: Get intSourceFile, , strFileData
190: rstData.Fields(strField).AppendChunk strFileData
200: varRetVal = SysCmd(acSysCmdUpdateMeter, BlockSize * i / 1000)
210: Next i
' Update the record and terminate function.
220: rstData.Update
230: varRetVal = SysCmd(acSysCmdRemoveMeter)
240: Close intSourceFile
250: ReadBLOB = lngFileLength
260: Exit Function
Err_ReadBLOB:
270: ReadBLOB = -Err
280: Exit Function
End Function
' 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 and the correct record navigated to prior to calling the WriteBLOB() function.
Function WriteBLOB(rstData As Recordset, strField As String, strDest As String) As Long
Dim intNumBlocks As Integer
Dim intDestFile As Integer
Dim i As Integer
Dim lngFileLength As Long
Dim lngLeftOver As Long
Dim strFileData As String
Dim varRetVal As Variant
On Error GoTo Err_WriteBLOB
' Get the size of the field.
10: lngFileLength = rstData.Fields(strField).FieldSize
20: If lngFileLength = 0 Then
30: WriteBLOB = 0
40: Exit Function
50: End If
' Calculate number of blocks to write and leftover bytes.
60: intNumBlocks = lngFileLength \ BlockSize
70: lngLeftOver = lngFileLength Mod BlockSize
' Remove any existing destination file.
80: intDestFile = FreeFile
90: Open strDest For Output As intDestFile
100: Close intDestFile
' Open the destination file.
110: Open strDest For Binary As intDestFile
' SysCmd is used to manipulate the status bar meter.
120: varRetVal = SysCmd(acSysCmdInitMeter, "Writing BLOB", lngFileLength / 1000)
' Write the leftover data to the output file.
130: strFileData = rstData.Fields(strField).GetChunk(0, lngLeftOver)
140: Put intDestFile, , strFileData
' Update the status bar meter.
150: varRetVal = SysCmd(acSysCmdUpdateMeter, lngLeftOver / 1000)
' Write the remaining blocks of data to the output file.
160: For i = 1 To intNumBlocks
' Reads a chunk and writes it to output file.
170: strFileData = rstData.Fields(strField).GetChunk((i - 1) * BlockSize + lngLeftOver, BlockSize)
180: Put intDestFile, , strFileData
190: varRetVal = SysCmd(acSysCmdUpdateMeter, ((i - 1) * BlockSize + lngLeftOver) / 1000)
200: Next i
' Terminates function
210: varRetVal = SysCmd(acSysCmdRemoveMeter)
220: Close intDestFile
230: WriteBLOB = lngFileLength
240: Exit Function
Err_WriteBLOB:
250: WriteBLOB = -Err
260: Exit Function
End Function
Public Sub storeFile(strSource As String, strTable As String, strField As String)
Dim rst As Recordset
Dim tdf As TableDef
Dim blnExists As Boolean
10: If Len(Dir(strSource)) < 1 Then
20: Exit Sub
30: End If
40: For Each tdf In CurrentDb.TableDefs
50: If tdf.Name = strTable Then
60: blnExists = True
70: Exit For
80: End If
90: Next
100: If Not blnExists Then
110: Set tdf = CurrentDb.CreateTableDef(strTable)
120: tdf.Fields.Append tdf.CreateField(strField, dbLongBinary)
130: CurrentDb.TableDefs.Append tdf
140: End If
150: Set rst = CurrentDb.OpenRecordset(strTable, dbOpenDynaset)
160: With rst
170: .AddNew
180: .Update
190: .MoveLast
200: End With
210: ReadBLOB strSource, rst, strField
220: rst.Close
230: Set rst = Nothing
End Sub
