i am trying to take an embedded image out of a database and create a file. for some reason, when i run the createfile sub, the file is created. but when i look at the file, it is not able to be viewed as an image file. If i use a different type of file, zip,doc, etc... the file works perfectly fine.
here is my code.
David Kuhn
------------------
here is my code.
Code:
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 (Access Basic
' code in Microsoft Access 2.0 and earlier) and the correct record
' navigated to prior to calling the ReadBLOB() function.
'
' ARGUMENTS:
' Source - The path and filename of the binary information
' to be read and stored.
' T - The table object to store the data in.
' Field - The OLE object field in table T to store the data in.
'
' RETURN:
' The number of bytes read from the Source file.
'**************************************************************
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 String
Dim RetVal As Variant
On Error GoTo Err_ReadBLOB
' Open the source file.
SourceFile = FreeFile
Open Source For Binary Access Read As SourceFile
' Get the length of the file.
FileLength = LOF(SourceFile)
If FileLength = 0 Then
ReadBLOB = 0
Exit Function
End If
' Calculate the number of blocks to read and leftover bytes.
NumBlocks = FileLength \ BlockSize
LeftOver = FileLength Mod BlockSize
' SysCmd is used to manipulate status bar meter.
RetVal = SysCmd(acSysCmdInitMeter, "Reading BLOB", FileLength \ 1000)
' Put the record in edit mode.
T.Edit
' Read the leftover data, writing it to the table.
FileData = String$(LeftOver, 32)
Get SourceFile, , FileData
T(sField).AppendChunk (FileData)
RetVal = SysCmd(acSysCmdUpdateMeter, LeftOver / 1000)
' Read the remaining blocks of data, writing them to the table.
FileData = String$(BlockSize, 32)
For i = 1 To NumBlocks
Get SourceFile, , FileData
T(sField).AppendChunk (FileData)
RetVal = SysCmd(acSysCmdUpdateMeter, BlockSize * i / 1000)
Next i
' Update the record and terminate function.
T.Update
RetVal = SysCmd(acSysCmdRemoveMeter)
Close SourceFile
ReadBLOB = FileLength
Exit Function
Err_ReadBLOB:
ReadBLOB = -Err
Exit Function
End Function
'**************************************************************
' FUNCTION: WriteBLOB()
'
' 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 (Access Basic
' code in Microsoft Access 2.0 or earlier) and the correct
' record navigated to prior to calling the WriteBLOB() function.
'
' ARGUMENTS:
' T - The table object containing the binary information.
' sField - The OLE object field in table T containing the
' binary information to write.
' Destination - The path and filename to write the binary
' information to.
'
' RETURN:
' The number of bytes written to the destination file.
'**************************************************************
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 String
Dim RetVal As Variant
On Error GoTo Err_WriteBLOB
' 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
Err_WriteBLOB:
WriteBLOB = -Err
Exit Function
End Function
'**************************************************************
' SUB: CopyFile
'
' PURPOSE:
' Demonstrates how to use ReadBLOB() and WriteBLOB().
'
' PREREQUISITES:
' A table called workorder that contains an OLE Object field called
' woimage.
'
' ARGUMENTS:
' Source - The path and filename of the information to copy.
' Destination - The path and filename of the file to write
' the binary information to.
'
' EXAMPLE:
' CopyFile "c:\windows\winfile.hlp", "c:\windows\winfil_1.hlp"
'**************************************************************
Sub CopyFile(Source As String, Destination As String)
Dim BytesRead As Variant, BytesWritten As Variant
Dim Msg As String
Dim db As Database
Dim T As Recordset
' Open the workorder table.
Set db = CurrentDb()
Set T = db.OpenRecordset("BLOB", dbOpenTable)
' Create a new record and move to it.
T.AddNew
T.Update
T.MoveLast
BytesRead = ReadBLOB(Source, T, "Blob")
Msg = "Finished reading """ & Source & """"
Msg = Msg & Chr$(13) & ".. " & BytesRead & " bytes read."
MsgBox Msg, 64, "Copy File"
BytesWritten = WriteBLOB(T, "Blob", Destination)
Msg = "Finished writing """ & Destination & """"
Msg = Msg & Chr$(13) & ".. " & BytesWritten & " bytes written."
MsgBox Msg, 64, "Copy File"
End Sub
'**************************************************************
' SUB: CopyFile
'
' PURPOSE:
' Demonstrates how to use ReadBLOB() and WriteBLOB().
'
' PREREQUISITES:
' A table called workorder that contains an OLE Object field called
' woimage.
'
' ARGUMENTS:
' Source - The path and filename of the information to copy.
' Destination - The path and filename of the file to write
' the binary information to.
'
' EXAMPLE:
' CopyFile "c:\windows\winfile.hlp", "c:\windows\winfil_1.hlp"
'**************************************************************
Sub CreateFile(Record As String, Destination As String)
Dim BytesWritten As Variant
Dim Msg As String
Dim db As Database
Dim T As Recordset
Dim qry As String
' Open the workorder table.
Set db = CurrentDb()
Set T = db.OpenRecordset("Select * FRom workorder where workorder = '" & Record & "'")
BytesWritten = WriteBLOB(T, "woimage", Destination)
Msg = "Finished writing """ & Destination & """"
Msg = Msg & Chr$(13) & ".. " & BytesWritten & " bytes written."
MsgBox Msg, 64, "Copy File"
End SubDavid Kuhn
------------------
![[pc2]](/data/assets/smilies/pc2.gif "[pc2] [pc2]")
