EXTRAER UNA IMAGEN DE UNA BD A VB (II)
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