Mensajes

este es un ejemplo que te ayudra creas una tabla con acess llamada bd1 con tres campos
Id_foto   tipo texto
nombre  tipo texto
foto        objeto ole

base de datos



formulario



agregar foto



nota no esta validado completamente pero muestra lo que tu pides o sea la foto ejecuta el programa les das add escojes la foto y le das guardar en el icono del diskette llenas las cajas de texto y listo
creas un modulo
'********
Option Explicit
Dim DataFile As Integer
Dim Chunk() As Byte
Const conChunkSize As Integer = 16384

Public Sub LeerBinary(campoBinary As Field, unPicture As PictureBox)
Dim lngCompensación As Long
Dim lngTamañoTotal As Long
   
    DataFile = FreeFile
    Open "pictemp" For Binary Access Write As DataFile
    lngTamañoTotal = campoBinary.ActualSize
    'MsgBox lngTamañoTotal
     
    Do While lngCompensación < lngTamañoTotal
        Chunk() = campoBinary.GetChunk(lngCompensación + conChunkSize)
        Put DataFile, , Chunk()
        lngCompensación = lngCompensación + conChunkSize
    Loop
    Close DataFile
    unPicture.Picture = LoadPicture("pictemp")
   
    On Local Error Resume Next
    If Len(Dir$("pictemp")) Then
        Kill "pictemp"
    End If
    Err = 0

End Sub
' *******************************************************
Public Sub GuardarBinary(campoBinary As Field, unPicture As PictureBox)
    'Guardar el contenido del Picture en el campo de la base
    Dim i As Integer
    Dim Fragment As Integer, Fl As Long, Chunks As Integer
   
    '
    'NOTA:
    '   El recordset debe estar preparado para Editar o Añadir
    '
   
    'Guardar el contenido del picture en un fichero temporal
    SavePicture unPicture.Picture, "pictemp"
   
    'Leer el fichero y guardarlo en el campo
    DataFile = FreeFile
    Open "pictemp" For Binary Access Read As DataFile
    Fl = LOF(DataFile)    ' Longitud de los datos en el archivo
    If Fl = 0 Then Close DataFile: Exit Sub
   
    Chunks = Fl \ conChunkSize
    Fragment = Fl Mod conChunkSize
    ReDim Chunk(Fragment)
   
    Get DataFile, , Chunk()
    campoBinary.AppendChunk Chunk()
    ReDim Chunk(conChunkSize)
    For i = 1 To Chunks
        Get DataFile, , Chunk()
        campoBinary.AppendChunk Chunk()
    Next i
    Close DataFile
   
    'Ya no necesitamos el fichero, así que borrarlo
    On Local Error Resume Next
    If Len(Dir$("pictemp")) Then
        Kill "pictemp"
    End If
    Err = 0
End Sub
'*********
codigo formulario
'**************
Private Sub CmdAnterior_Click()
  DePrueba.rsCmFoto.MovePrevious
If DePrueba.rsCmFoto.BOF Then
   DePrueba.rsCmFoto.MoveNext
End If
LeerBinary DePrueba.rsCmFoto!FOTO, Picture1
End Sub

Private Sub CmdPrimero_Click()
DePrueba.rsCmFoto.MoveFirst
LeerBinary DePrueba.rsCmFoto!FOTO, Picture1
End Sub

Private Sub CmdSiguiente_Click()
DePrueba.rsCmFoto.MoveNext
If DePrueba.rsCmFoto.EOF Then
   DePrueba.rsCmFoto.MoveLast
End If
LeerBinary DePrueba.rsCmFoto!FOTO, Picture1
End Sub

Private Sub CmdUltimo_Click()
  DePrueba.rsCmFoto.MoveLast
  LeerBinary DePrueba.rsCmFoto!FOTO, Picture1
End Sub

Private Sub Command1_Click() ' añadir nuevo
  DePrueba.rsCmFoto.AddNew
  Picture1.Picture = LoadPicture()
  CommonDialog1.ShowOpen
    If CommonDialog1.FileName <> "" Then
       Picture1.Picture = LoadPicture(CommonDialog1.FileName)
    End If
End Sub

Private Sub Command4_Click() ' actualizar
If txtId_Foto <> "" And txtNombre <> "" Then
    GuardarBinary DePrueba.rsCmFoto!FOTO, Picture1
    DePrueba.rsCmFoto.Update
Else
  MsgBox "LLene Los Campos"
End If
End Sub

Private Sub Form_Load()
If Not DePrueba.rsCmFoto.EOF Then
  LeerBinary DePrueba.rsCmFoto!FOTO, Picture1
End If
End Sub
'**************

aqui en el ejemplo trabajo con dataenviroment