Abundant Technologies - IT Consulting Experts

 Source Code Library

 Code Details

 
' Copy a BLOB field's contents to a binary file. Sub BlobToFile(fld As ADODB.Field, filename As String, Optional ChunkSize As Long = 8192) Dim fnum As Integer Dim bytesLeft As Long Dim bytes As Long Dim tmp() As Byte ' Raise an error if the field doesn't support GetChunk. If (fld.Attributes And adFldLong) = 0 Then Err.Raise 1001, , "Field doesn't support the GetChunk method." End If ' Open the file;, delete it firstoverwrite it if necessary.' Delete the ' file if it exists already, then create a new one. If Dir$(filename) <> "" Then If MsgBox("File exists, overwrite?", vbYesNo) = vbYes Then Kill filename End If fnum = FreeFile Open filename For Binary As fnum ' Read the field's contents, and write it the data to the file. bytesLeft = fld.ActualSize Do While bytesLeft bytes = bytesLeft If bytes > ChunkSize Then bytes = ChunkSize tmp = fld.GetChunk(bytes) Put #fnum, , tmp bytesLeft = bytesLeft - bytes Loop Close #fnum End Sub ' Copy a file's contents into a BLOB field. Sub FileToBlob(fld As ADODB.Field, filename As String, Optional ChunkSize As Long = 8192) Dim fnum As Integer Dim bytesLeft As Long Dim bytes As Long Dim tmp() As Byte ' Raise an error if the field doesn't support GetChunk. If (fld.Attributes And adFldLong) = 0 Then Err.Raise 1001, , "Field doesn't support the GetChunk method." End If ' Open the file; raise an error if the file doesn't exist. If Dir$(filename) = "" Then Err.Raise 53, , "File not found" fnum = FreeFile Open filename For Binary As fnum ' Read the file in chunks, and append data to the field. bytesLeft = LOF(fnum) Do While bytesLeft bytes = bytesLeft If bytes > ChunkSize Then bytes = ChunkSize ReDim tmp(1 To bytes) As Byte Get #1, , tmp fld.AppendChunk tmp bytesLeft = bytesLeft - bytes Loop Close #fnum End Sub

Mail To: info@3pc.com