Visual Basic - QUE NO SE PUEDE EXTRAER UNA IMAGEN DE UNA BD A VB

Hola
Alguien me pude decir porfavor como le hago para mostrar una imagen de una bd de access en vb, el campo donde esta la imagen es tipo ole pues no he podido dar con la solucion ojala me puedan ayudar porfavor!!!!!!
Gracias!!!

En un módulo .bas:

'-----------------------------------------------------------------
'Código para grabar y leer imagenes en campos de bases Access
'------------------------------------------------------------------
Option Explicit

Dim iDataFile As Integer
Dim bChunk() As Byte
Const iChunkSize As Integer = 16384

Public Sub LeerBinaryPic(campoBinary As Field, m_Picture As PictureBox)
'Leer la imagen del campo de la base y asignarlo al Picture
Dim lngCompensación As Long
Dim lngTamañoTotal As Long

'Se usa un fichero temporal para guardar la imagen
On Local Error GoTo LeerBinary_Err
iDataFile = FreeFile
Open "pictemp" For Binary Access Write As iDataFile

lngTamañoTotal = campoBinary.FieldSize
Do While lngCompensación < lngTamañoTotal
bChunk() = campoBinary.GetChunk(lngCompensación, iChunkSize)
Put iDataFile, , bChunk()
lngCompensación = lngCompensación + iChunkSize
Loop

Close iDataFile
'Ahora se carga esa imagen en el control
m_Picture.Picture = LoadPicture("pictemp")

'Ya no necesitamos el fichero, así que borrarlo
If Len(Dir$("pictemp")) Then
Kill "pictemp"
End If
Err = 0

LeerBinary_Err:
If Err.Number = 50003 Then '// no hay imagen, campo vacio
m_Picture.Picture = LoadPicture() '// no cargamos nada
Err = 0
ElseIf Err <> 0 Then
MsgBox Error$(Err)
End If
On Local Erro

En el mensaje anterior la penúltima linea está incompleta y falta el End Sub, por tanto debe ser:
On Local Error GoTo 0
End Sub
Seguimos:

Public Sub GuardarBinaryPic(campoBinary As Field, m_Picture As PictureBox)
'Guardar el contenido del Picture en el campo de la base
Dim i As Integer
Dim Fragment As Integer, Fl As Long, bChunks As Integer
'NOTA:
' El recordset debe estar preparado para Editar o Añadir

'Guardar el contenido del picture en un fichero temporal
On Local Error GoTo GuardarBinary_Err
SavePicture m_Picture.Picture, "C:\pictemp.GIF"
'Leer el fichero y guardarlo en el campo
iDataFile = FreeFile
Open "C:\pictemp.GIF" For Binary Access Read As iDataFile
Fl = LOF(iDataFile) ' Longitud de los datos en el archivo
If Fl = 0 Then Close iDataFile: Exit Sub
bChunks = Fl \ iChunkSize
Fragment = Fl Mod iChunkSize
ReDim bChunk(Fragment)
Get iDataFile, , bChunk()
campoBinary.AppendChunk bChunk()
ReDim bChunk(iChunkSize)
For i = 1 To bChunks
Get iDataFile, , bChunk()
campoBinary.AppendChunk bChunk()
Next i
Close iDataFile
'Ya no necesitamos el fichero, así que borrarlo, si se quiere
On Local Error Resume Next
If Len(Dir$("C:\pictemp.GIF")) Then
' Kill "pictemp.gif"
End If
Err = 0
GuardarBinary_Err:
If Err = 380 Then '// este error me ocurria ami y no es grave
Err = 0
ElseIf Err <> 0 Then

A mí me funciona, lo que pasa es que tuve que dejar este método porque la base de datos aumenta considerablemente hasta no ser asumible.

Lo más práctico, que es lo que acabé haciendo: guardar las imagenes en disco, almacenar en un campo de texto la ruta del gráfico, y cargarlo en un PictureBox

Es posible que las funciones de leer y grabar tengas que adaptarlas un poco (muy poco, por cierto).

Espero haberte sido de utilidad.
Saludos
Pere

Faltan unas líneas para acabar la función:
MsgBox Error$(Err)
End If
End Sub

Disculpa, pensaba que cabía todo, no sabía que hay un límite para escribir.

Saludos
Pere

Gracias Pere, lo voy a probar, y funcionara igual para vb5?
Bueno lo voy a probar, muchas gracias por tu tiempo.
DIOS te bendiga!!!

Yo lo uso con Vb5. Si te fijas, no usa ninguna llamada a Api's, es todo código de Visual. Esa es la gran ventaja.

Saludos
Pere