A continuación se implementará un procedimiento que servirá para añadir una imagen a un campo de una tabla, el cual deberá de tener definido el tipo de dato correcto para almacenar el archivo gráfico.
Inserte un control Image en el formulario, y copie y pegue el siguiente código en la sección Declaraciones del formulario de inicio del proyecto.
Option Explicit
'
' El procedimiento guardará la imagen indicada en la ruta del archivo
' en el valor del campo pasado.
'
Private
Sub SaveBinaryFile(fld As
ADODB.Field, ByVal strFileName
As String)
Dim x
As Long, iFile
As Integer
Dim lSize
As Long, lChunks
As Long
Dim Chunk()
As Byte
Const Buffer
As Long = 16384&
On
Error GoTo ErrSaveBinaryFile
' El objeto Recordset deberá estar
dispuesto para
' Añadir o Editar datos, ya que de lo contrario
' fallará el método AppendChunk
' Abrimos el archivo para leermo
iFile = FreeFile
Open strFileName
For Binary
Access Read
As iFile
' Si el tamaño del archivo es cero,
salimos del procedimiento
lSize = LOF(iFile)
If (lSize = 0)
Then
Close
iFile
Exit
Sub
End
If
' Calculamos los trozos que
componen el archivo
ReDim Chunk(lSize
Mod Buffer)
lChunks = lSize \ Buffer
' Leemos el archivo gráfico
indicado ...
Get iFile, , Chunk()
' ... y vamos añadiendo los datos
al objeto Field
fld.AppendChunk Chunk()
ReDim Chunk(Buffer)
For x = 1
To lChunks
Get
iFile, , Chunk()
fld.AppendChunk Chunk()
Next x
ErrSaveBinaryFile:
' Si se ha producido algún error,
mostramos
' la descripción del mismo
If (Err.Number)
Then
MsgBox Err.Description,
vbInformation, "Guardar archivo binario"
End
If
' Cerramos el archivo
Close iFile
End Sub
Para ejecutar el procedimiento, bien podríamos utilizar el siguiente ejemplo:
Dim cnn As
ADODB.Connection
Dim rst As
ADODB.Recordset
' Creamos un nuevo objeto Connection
Set cnn = New
ADODB.Connection
' Configuramos y abrimos la conexión
With cnn
.Provider="Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=C:\Mis
documentos\bd1.mdb"
.Open
End With
' Creamos una tabla nueva para probar el ejemplo
cnn.Execute "CREATE TABLE Tabla1(" & _
"Foto
LONGBINARY)"
' Creamos un nuevo objeto Recordset
Set rst = New
ADODB.Recordset
' Configuramos y abrimos el objeto Recordset
With rst
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open "Tabla1", cnn, , , adCmdTable
' Añadimos un nuevo registro
.AddNew
' Guardamos el valor del campo
SaveBinaryFile rst.Fields!Foto, "C:\Mis
imágenes\Margaritas.bmp"
' Actualizamos el conjunto de registros
.Update
End With
' Mostramos la image
Set Image1.DataSource = rst
Image1.DataField = "Foto"
Enrique Martínez Montejo - 2004
NOTA: La información contenida en este artículo, así como el código fuente incluido en el mismo, se proporciona COMO ESTÁ, sin garantías de ninguna clase, y no otorga derecho alguno. Usted asume cualquier riesgo al poner en práctica, utilizar o ejecutar lo explicado, recomendado o sugerido en el presente artículo.
NOTE: The information contained in this article and source code included therein, is provided AS IS without warranty of any kind, and confers no rights. You assume any risk to implement, use or run it explained, recommended or suggested in this article.