Vincular registros a imagenes URGENTE

Tengo dos metodos para ayudarte.
Dame un par de horas para armarte los ejemplos.
Respuesta
1
Te escribo el primer ejemplo para no detenerme mucho.
Este ejemplo incrustara una imagen dentro de un registro de algun campo. Claro determinando que esto se realiza mediante un formulario
El campo debe ser de objetoOle para que pueda guardarlo y visualizarlo una vez incrustado. Se divide en tres parte 1) es la accion final 2)generar la accion de jalar la imagen e importarla a tu tabla, a metodo como si abrieras un archivo, nada de ctl. C y ctl. V.
Y el 3)Es el metodo para abrir el cuadro de dialogo del dll de Microsoft Windows Explorer.
Primera parte BOTON QUE EJERCE ACCION
Private Sub Botón2_Click()
Dim s As String
s = OpenCommDlg()
If s <> "" Then
If IsNull([Cam1]) Then
Else
End If
Me.Cam1 = s
CFoto
End If
Exit Sub
End Sub
PARTE 2
Aqui es donde se enlaza el CFOTO, donde jalara el archivo de origen y lo incustara en un campo de la tabla
Private Sub CFoto()
On Error GoTo ECFOTO
Dim NNick As Control
Set NNick = Forms![Menu]![Nick]
Me.Cam1.Enabled = True
Me.Cam1.Locked = False
Me.Cam1.OLETypeAllowed = acOLEEmbedded
Me.Cam1.SourceDoc = Me.Cam1
Me.Cam1.Action = acOLECreateEmbed
Me.Botón3.SetFocus
Me.Cam1.Enabled = False
Me.Cam1.Locked = True
Exit Sub
ECFOTO:
MsgBox NNick & ", ocurrio un error grave al intentar cargar la imagen a la Base de datos. Vuelva a intentar, verificando que se trata de un archivo de imagen el que se intenta cargar.", vbCritical, "Varana: Error de cargado de imagen"
Me.Botón1.SetFocus
Me.Cam1.Enabled = False
Me.Cam1.Locked = True
Exit Sub
End Sub
PARTE 3
Aqui este modulo se incorpora dentro de modulos para genera esta opcion de jalar el cuadro de dialogo desde una api de windows.
Option Compare Database
Option Explicit
Type tagOPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Declare Function apiGetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (OPENFILENAME As tagOPENFILENAME) As Long
'
Dim OPENFILENAME As tagOPENFILENAME
Public Const OFN_READONLY = &H1
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_SHOWHELP = &H10
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOLONGNAMES = &H40000
Public Const OFN_EXPLORER = &H80000
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_LONGNAMES = &H200000
Public Const OFN_SHAREFALLTHROUGH = 2
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHAREWARN = 0
'Abre el cuadro de dialogo en busca de la imagen a importar
Function OpenCommDlg()
Dim Message$, Filter$, FileName$, FileTitle$, DefExt$
Dim Title$, szCurDir$, APIResults&
'
Filter$ = "Imágenes Varana (gif, pcx, bmp, jpg)" & Chr$(0) & "*.BMP;*.GIF;*.PCX;*.JPG;" & Chr$(0) & _
"Todos los ficheros (*.*)" & Chr(0) & "*.*;" & Chr(0)
Filter$ = Filter$ & Chr$(0)
'
FileName$ = Chr$(0) & Space$(255) & Chr$(0)
FileTitle$ = Space$(255) & Chr$(0)
Title$ = "Seleccionar imagen" & Chr$(0)
'
DefExt$ = "BMP" & Chr$(0) ' extensión por defecto
szCurDir$ = CurDir$ & Chr$(0) ' directorio por defecto, el actual
OPENFILENAME.lStructSize = Len(OPENFILENAME)
OPENFILENAME.hwndOwner = Screen.ActiveForm.hwnd
OPENFILENAME.lpstrFilter = Filter$
OPENFILENAME.nFilterIndex = 1
OPENFILENAME.lpstrFile = FileName$
OPENFILENAME.nMaxFile = Len(FileName$)
OPENFILENAME.lpstrFileTitle = FileTitle$
OPENFILENAME.nMaxFileTitle = Len(FileTitle$)
OPENFILENAME.lpstrTitle = Title$
OPENFILENAME.flags = OFN_FILEMUSTEXIST Or OFN_READONLY Or OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST
OPENFILENAME.lpstrDefExt = DefExt$
OPENFILENAME.hInstance = 0
OPENFILENAME.lpstrCustomFilter = String(255, 0)
OPENFILENAME.nMaxCustFilter = 255
OPENFILENAME.lpstrInitialDir = szCurDir$
OPENFILENAME.nFileOffset = 0
OPENFILENAME.nFileExtension = 0
OPENFILENAME.lCustData = 0
OPENFILENAME.lpfnHook = 0
OPENFILENAME.lpTemplateName = 0
If apiGetOpenFileName(OPENFILENAME) <> 0 Then
OpenCommDlg = Left$(OPENFILENAME.lpstrFile, InStr(OPENFILENAME.lpstrFile, Chr$(0)) - 1)
Else
OpenCommDlg = ""
End If
End Function

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas