How to Get Data From a Binary Field and save it to a File

'Read data from SQL Server Binary Field (BLOB) and save it to a file with ADO
' params:
' sTable : Table Name
' sBinaryField: Binary Column Name where to get the binary data
' sKeyFld: Key Field Name to indicate the record to update
' KeyValue: Key Field Value
' SFileDest: Path & File Name where is going to save the binary data
'
' ie: Call getBinary("pub_info", "logo", "pub_id", "0736", "c:\images\logo0736.jpg")
' saves the column logo binary content of pub_info table where pub_id = '0736'
' as the file "c:\images\logo0736.jgp
'
'author: Roberto Figueroa
'date: 07-Jun-2005

Public Function getBinary(ByVal sTable As String, ByVal sBinaryFld As String, _
ByVal sKeyFld As String, ByVal KeyValue As String, ByVal sFileDest As String) As Boolean

Dim sQry As String, rs As ADODB.RecordSet
Dim Stm As ADODB.Stream

On Error GoTo errHandler

sQry = "SELECT " & sBinaryFld & " FROM " & sTable & " WHERE " & sKeyFld & " = " & KeyValue

Set rs = New ADODB.Recordset
rs.Open sQry, adoConn , adOpenStatic, adLockReadOnly, adCmdText

If rs.Fields(0).ActualSize > 0 Then

Set Stm = New ADODB.Stream

With Stm

.Type = adTypeBinary
.Open
.Write rs.Fields(0).Value
.SaveToFile sFileDest, adSaveCreateOverWrite

End With
Set Stm = Nothing

getBinary = True
Else
getBinary = False
End If


Exit Function

errHandler:
Err.Raise vbObjectError + 2, "getBinary", "Error on getting binary data"

End Function

How to Save Data to a Binary Field

'saveBinary: save file content on a binary field (BLOB)
'(binary, varbinary, and image data types in Ms SQLServer 2000)
'params:
' sTable : Table Name
' sBinaryField: Column Name that is going to be changed (Binary Field)
' sKeyFld: Key Field Name for indicate the record to update
' KeyValue: Key Field Value
' SFile: Path & File Name that is going to be saved, "" to update with NULL
'
'ie: call saveBinary("pub_info", "logo", "pub_id", "'0736'", "c:\images\foto.jpg")
'saves the file c:\images\foto.jpg on the logo field of pub_info table (pubs database)
'on the record where pub_id = '0736'
'note: the single quotation mark is necesary because pub_id is a varchar field
'
'Author: Roberto Figueroa G.
'Date: 07-Jun-2005
Public Sub saveBinary(ByVal sTable As String, ByVal sBinaryFld As String, _
ByVal sKeyFld As String, ByVal KeyValue As String, Optional ByVal sFile As String = "")

Dim Stm As ADODB.Stream, rs As ADODB.RecordSet
Dim sQry As String

On Error GoTo errHandler

sQry = "SELECT " & sBinaryFld & " FROM " & sTable & " WHERE " & sKeyFld & " = " & KeyValue

Set rs = New ADODB.RecordSet
rs.open strQuery, adoConn, adOpenStatic, adLockOptimistic, adCmdText


If sFile > "" Then

Set Stm = New ADODB.Stream

With Stm

.Type = adTypeBinary
.Open
.LoadFromFile sFile
rs.Fields(0).Value = .Read

End With

Set Stm = Nothing

Else
rs.Fields(0).Value = Null

End If

rs.Update
rs.Close
Set rs = Nothing

Exit Sub

errHandler:
Err.Raise vbObjectError + 6, "saveBinary", "Error on updating field"
End Sub