Guardar imágenes en access y cagar en vba
Necesito de vuestra ayuda.
Como crear un código para que me guarde la imagen en una base de datos (Access) y un código para que me devuelva la imagen a VBA.
Os adjunto el código, supongo que debo hacer algo mal, me puede ayudar alguien por favor.
Private Sub cmd_Anterior_Click()
Rs.MovePrevious 'Nos movemos al registro anterior
If Rs.BOF Then Rs.MoveFirst: MsgBox "Primer Registro", vbInformation, "Clientes"
'Image1.Picture = Rs.Fields("Imagen")
End Sub
Private Sub cmd_Eliminar_Click()
Dim Registro As String
If txtNombre.Text = "" And txtDireccion.Text = "" And txtTel.Text = "" And txtCel.Text = "" _
And txtEmail.Text = "" And Image1.Picture = "" Then
MsgBox "Debe seleccionar un registro", , "Clientes"
Exit Sub
End If
Registro = txtNombre.Text
If MsgBox("¿Seguro que desea eliminar a " & Registro & "?" + Chr(13) + "¿Desea proceder?", vbOKCancel) = vbOK Then
Rs.Delete
MsgBox Registro & " ha sido eliminado", vbInformation, "Clientes"
cmd_Primero_Click
Else
Exit Sub
End If
End Sub
Private Sub cmd_Guardar_Click()
If txtNombre.Text = "" And txtDireccion.Text = "" And txtTel.Text = "" And txtCel.Text = "" And txtEmail.Text = "" And Image1.Picture = "" Then
MsgBox "Debe completar todos los campos", , "Clientes"
Exit Sub
End If
Rs.AddNew
Rs.Fields("Imagen") = Image1.Picture
Rs.Update
MsgBox "Registro Guardado correctamente", vbInformation, "Clientes"
cmd_Primero_Click
cmd_Nuevo.Enabled = True
cmd_Guardar.Enabled = False
cmd_Modificar.Enabled = True
cmd_Eliminar.Enabled = True
cmd_Primero.Enabled = True
cmd_Anterior.Enabled = True
cmd_Siguiente.Enabled = True
cmd_Ultimo.Enabled = True
End Sub
Private Sub cmd_Modificar_Click()
If txtNombre.Text = "" And txtDireccion.Text = "" _
And txtTel.Text = "" And txtCel.Text = "" _
And txtEmail.Text = "" And Image1.Picture = "" Then
MsgBox "Debe seleccionar un registro", , "Clientes"
Exit Sub
End If
'Rs.Fields("Imagen") = Image1.Picture
Rs.Update
MsgBox "Registro Modificado correctamente", vbInformation, "Clientes"
cmd_Primero_Click
End Sub
Private Sub cmd_Nuevo_Click()
Dim i As Control
For Each i In Controls
If i.Name Like "txt*" Then i = Empty
Next
txtNombre.SetFocus
cmd_Guardar.Enabled = True
cmd_Nuevo.Enabled = False
cmd_Modificar.Enabled = False
cmd_Eliminar.Enabled = False
cmd_Primero.Enabled = False
cmd_Anterior.Enabled = False
cmd_Siguiente.Enabled = False
cmd_Ultimo.Enabled = False
End Sub
Private Sub cmd_Primero_Click()
Rs.MoveFirst 'Nos movemos al primer registro
'Image1.Picture = Rs.Fields("Imagen")
End Sub
Private Sub cmd_Siguiente_Click()
Rs.MoveNext 'Nos movemos al siguiente registro
If Rs.EOF Then Rs.MoveLast: MsgBox "Último Registro", vbInformation, "Clientes"
'Image1.Picture = Rs.Fields("Imagen")
End Sub
Private Sub cmd_Ultimo_Click()
Rs.MoveLast 'Nos movemos al último registro
'Image1.Picture = Rs.Fields("Imagen")
End Sub
Private Sub CommandButton1_Click()
'Private Sub cmd_Imagen_Click()
On Error Resume Next
ArchivoIMG = Application.GetOpenFilename("Imágenes jpg,*.jpg,Imágenes bmp,*.bmp", 0, "Seleccionar Imágen para Reegistro de Clientes")
Image1.Picture = LoadPicture("")
Image1.Picture = LoadPicture(ArchivoIMG)
End Sub
'imag = ThisWorkbook.Path & "\img\" & TextBox1 & ".jpg"
'On Error Resume Next 'si hay error se saltea la siguiente linea
'Image1.Picture = LoadPicture(imag)
'End Sub
Private Sub UserForm_Initialize()
Call Conecta 'Crea la conexion
Set Rs = New ADODB.Recordset
Rs. Open "SELECT * FROM Productos", miConexion, adOpenKeyset, adLockOptimistic, adCmdText
txtNombre.Text = Rs.Fields("Nombre")
txtDireccion.Text = Rs.Fields("Direccion")
'Image1.Picture = Rs.Fields("Imagen")
cmd_Guardar.Enabled = False
End Sub
