• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• Stores any binary data into the Database field. ex: zip files, exe files, images etc. Retrieves the

Stores any binary data into the Database field. ex: zip files, exe files, images etc. Retrieves the

Stores any binary data into the Database field. ex: zip files, exe files, images etc. Retrieves the stored binary data from the database field.

Rate Stores any binary data into the Database field. ex: zip files, exe files, images etc. Retrieves the

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

Function CopyFieldToFile(rst As DAO.Recordset, fd As String, strFileName As String) As String
 Dim FileNum As Integer
 Dim Buffer() As Byte
 Dim BytesNeeded As Long
 Dim Buffers As Long
 Dim Remainder As Long
 Dim Offset As Long
 Dim r As Integer
 Dim i As Long
 Dim ChunkSize As Long

 ChunkSize = 65536
 BytesNeeded = rst(fd).FieldSize
    If BytesNeeded > 0 Then
       ' Calculate the number of buffers needed to copy
        Buffers = BytesNeeded \ ChunkSize
        Remainder = BytesNeeded Mod ChunkSize
        ' Get a unique, temporary filename:

        If Dir(strFileName) <> "" Then
            Kill strFileName
        End If
        ' Copy the bitmap to the temporary file chunk by chunk:
        FileNum = FreeFile
        Open strFileName For Binary As #FileNum
        For i = 0 To Buffers - 1
           ReDim Buffer(ChunkSize)
           Buffer = rst(fd).GetChunk(Offset, ChunkSize)
           Put #FileNum, , Buffer()
           Offset = Offset + ChunkSize
        Next        ' Copy the remaining chunk of the bitmap to the file:
        ReDim Buffer(Remainder)
        Buffer = rst(fd).GetChunk(Offset, Remainder)
        Put #FileNum, , Buffer()
        Close #FileNum
    End If
    CopyFieldToFile = strFileName
End Function

Function CopyFileToField(FileName As String, fd As DAO.Field)
 Dim ChunkSize As Long
 Dim FileNum As Integer
 Dim Buffer()  As Byte
 Dim BytesNeeded As Long
 Dim Buffers As Long
 Dim Remainder As Long
 Dim i As Long

    If Len(FileName) = 0 Then
        Exit Function
    End If
    If Dir(FileName) = "" Then
        Err.Raise vbObjectError, , "File not found: """ & FileName & """"
    End If
    ChunkSize = 65536
    FileNum = FreeFile
    Open FileName For Binary As #FileNum
    BytesNeeded = LOF(FileNum)
    Buffers = BytesNeeded \ ChunkSize
    Remainder = BytesNeeded Mod ChunkSize
    For i = 0 To Buffers - 1
        ReDim Buffer(ChunkSize)
        Get #FileNum, , Buffer
        fd.AppendChunk Buffer
    Next
    ReDim Buffer(Remainder)
    Get #FileNum, , Buffer
    fd.AppendChunk Buffer
    Close #FileNum

End Function

'----------- Use of CopyFieldToFile ----------------
1. You must have a recordset open.
Call CopyFieldToFile <recordset>, "<Field>", "<Filename>"

'----------- Use of CopyFileToField ----------------
1. You must have a recordset open.
Call CopyFileToField "<Filename>", "<FieldToWriteTheFileTo>"

If you want the whole program to see how it really works with 
source just send me an email.