Para gravar um JPG ou um DOC dentro do Access ou SQL você pode usar os métodos GetChunk para salvar e AppendChunk para ler, mas com exceção de arquivos texto que podem ser lidos diretamente para campos memo, outros tipos de arquivo seria melhor você deixa-los em uma pasta específica, e no seu banco de dados, apenas um campo string informando o caminho do arquivo. Mas de qualquer maneira, aqui vai um exemplo retirado do site da Microsoft para usar estes métodos.
Private Sub CmdSave_Click()
Dim cn As ADODB.Connection, rs As ADODB.Recordset, SQL As String
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
cn.CursorLocation = adUseServer
cn.Open "dsn=nwind_jet" ' *** change this ***
SQL = "SELECT * FROM Employees WHERE MaxName='Fuller'"
rs.Open SQL, cn, adOpenStatic, adLockReadOnly
'
' Save using GetChunk and known size.
' FieldSize (ActualSize) > Threshold arg (16384)
'
BlobToFile rs!Photo, "c:photo1.dat", rs!Photo.ActualSize, 16384
BlobToFile rs!Notes, "c:otes1.txt", rs!Notes.ActualSize, 16384
' Uncomment the next line of code, and comment the line above,
' to workaround Runtime error '94': Invalid use of Null
' BlobToFile rs!Notes, "c:otes1.txt", rs!Notes.ActualSize 2, 16384
'
' Save using GetChunk and unknown size.
' FieldSize not specified.
'
BlobToFile rs!Photo, "c:photo2.dat"
BlobToFile rs!Notes, "c:otes2.txt"
'
' Save without using GetChunk
' FieldSize (ActualSize) < Threshold arg (defaults to 1Mb)
'
BlobToFile rs!Photo, "c:photo3.dat", rs!Photo.ActualSize
BlobToFile rs!Notes, "c:otes3.txt", rs!Notes.ActualSize
' Uncomment the next line of code, and comment the line above,
' to workaround Runtime error '94': Invalid use of Null
' BlobToFile rs!Notes, "c:otes3.txt", rs!Notes.ActualSize 2
rs.Close
cn.Close
End Sub
Private Sub CmdLoad_Click()
Dim cn As ADODB.Connection, rs As ADODB.Recordset, SQL As String
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
cn.CursorLocation = adUseServer
cn.Open "dsn=ole_db_nwind_jet"
SQL = "SELECT * FROM Employees"
rs.Open SQL, cn, adOpenKeyset, adLockOptimistic
'
' Load using AppendChunk
'
rs.AddNew
rs!MinName = "Test"
rs!MaxName = "Fuller11"
FileToBlob "c:photo1.dat", rs!Photo, 16384
FileToBlob "c:otes1.txt", rs!Notes, 16384
rs.Update
rs.AddNew
rs!MinName = "Test"
rs!MaxName = "Fuller21"
FileToBlob "c:photo2.dat", rs!Photo, 16384
FileToBlob "c:otes2.txt", rs!Notes, 16384
rs.Update
rs.AddNew
rs!MinName = "Test"
rs!MaxName = "Fuller31"
FileToBlob "c:photo3.dat", rs!Photo, 16384
FileToBlob "c:otes3.txt", rs!Notes, 16384
rs.Update
'
' Load without using AppendChunk
'
rs.AddNew
rs!MinName = "Test"
rs!MaxName = "Fuller12"
FileToBlob "c:photo1.dat", rs!Photo
FileToBlob "c:otes1.txt", rs!Notes
rs.Update
rs.AddNew
rs!MinName = "Test"
rs!MaxName = "Fuller22"
FileToBlob "c:photo2.dat", rs!Photo
FileToBlob "c:otes2.txt", rs!Notes
rs.Update
rs.AddNew
rs!MinName = "Test"
rs!MaxName = "Fuller32"
FileToBlob "c:photo3.dat", rs!Photo
FileToBlob "c:otes3.txt", rs!Notes
rs.Update
rs.Close
cn.Close
End Sub
Crie um módulo e adicione:
Const BLOCK_SIZE = 16384
Sub BlobToFile(fld As ADODB.Field, ByVal FName As String, _
Optional FieldSize As Long = -1, _
Optional Threshold As Long = 1048576)
'
' Assumes file does not exist
' Data cannot exceed approx. 2Gb in size
'
Dim F As Long, bData() As Byte, sData As String
F = FreeFile
Open FName For Binary As #F
Select Case fld.Type
Case adLongVarBinary
If FieldSize = -1 Then ' blob field is of unknown size
WriteFromUnsizedBinary F, fld
Else ' blob field is of known size
If FieldSize > Threshold Then ' very large actual data
WriteFromBinary F, fld, FieldSize
Else ' smallish actual data
bData = fld.Value
Put #F, , bData ' PUT tacks on overhead if use fld.Value
End If
End If
Case adLongVarChar, adLongVarWChar
If FieldSize = -1 Then
WriteFromUnsizedText F, fld
Else
If FieldSize > Threshold Then
WriteFromText F, fld, FieldSize
Else
sData = fld.Value
Put #F, , sData ' PUT tacks on overhead if use fld.Value
End If
End If
End Select
Close #F
End Sub
Sub WriteFromBinary(ByVal F As Long, fld As ADODB.Field, _
ByVal FieldSize As Long)
Dim Data() As Byte, BytesRead As Long
Do While FieldSize <> BytesRead
If FieldSize - BytesRead < BLOCK_SIZE Then
Data = fld.GetChunk(FieldSize - BLOCK_SIZE)
BytesRead = FieldSize
Else
Data = fld.GetChunk(BLOCK_SIZE)
BytesRead = BytesRead + BLOCK_SIZE
End If
Put #F, , Data
Loop
End Sub
Sub WriteFromUnsizedBinary(ByVal F As Long, fld As ADODB.Field)
Dim Data() As Byte, Temp As Variant
Do
Temp = fld.GetChunk(BLOCK_SIZE)
If IsNull(Temp) Then Exit Do
Data = Temp
Put #F, , Data
Loop While LenB(Temp) = BLOCK_SIZE
End Sub
Sub WriteFromText(ByVal F As Long, fld As ADODB.Field, _
ByVal FieldSize As Long)
Dim Data As String, CharsRead As Long
Do While FieldSize <> CharsRead
If FieldSize - CharsRead < BLOCK_SIZE Then
Data = fld.GetChunk(FieldSize - BLOCK_SIZE)
CharsRead = FieldSize
Else
Data = fld.GetChunk(BLOCK_SIZE)
CharsRead = CharsRead + BLOCK_SIZE
End If
Put #F, , Data
Loop
End Sub
Sub WriteFromUnsizedText(ByVal F As Long, fld As ADODB.Field)
Dim Data As String, Temp As Variant
Do
Temp = fld.GetChunk(BLOCK_SIZE)
If IsNull(Temp) Then Exit Do
Data = Temp
Put #F, , Data
Loop While Len(Temp) = BLOCK_SIZE
End Sub
Sub FileToBlob(ByVal FName As String, fld As ADODB.Field, _
Optional Threshold As Long = 1048576)
'
' Assumes file exists
' Assumes calling routine does the UPDATE
' File cannot exceed approx. 2Gb in size
'
Dim F As Long, Data() As Byte, FileSize As Long
F = FreeFile
Open FName For Binary As #F
FileSize = LOF(F)
Select Case fld.Type
Case adLongVarBinary
If FileSize > Threshold Then
ReadToBinary F, fld, FileSize
Else
Data = InputB(FileSize, F)
fld.Value = Data
End If
Case adLongVarChar, adLongVarWChar
If FileSize > Threshold Then
ReadToText F, fld, FileSize
Else
fld.Value = Input(FileSize, F)
End If
End Select
Close #F
End Sub
Sub ReadToBinary(ByVal F As Long, fld As ADODB.Field, _
ByVal FileSize As Long)
Dim Data() As Byte, BytesRead As Long
Do While FileSize <> BytesRead
If FileSize - BytesRead < BLOCK_SIZE Then
Data = InputB(FileSize - BytesRead, F)
BytesRead = FileSize
Else
Data = InputB(BLOCK_SIZE, F)
BytesRead = BytesRead + BLOCK_SIZE
End If
fld.AppendChunk Data
Loop
End Sub
Sub ReadToText(ByVal F As Long, fld As ADODB.Field, _
ByVal FileSize As Long)
Dim Data As String, CharsRead As Long
Do While FileSize <> CharsRead
If FileSize - CharsRead < BLOCK_SIZE Then
Data = Input(FileSize - CharsRead, F)
CharsRead = FileSize
Else
Data = Input(BLOCK_SIZE, F)
CharsRead = CharsRead + BLOCK_SIZE
End If
fld.AppendChunk Data
Loop
End Sub
