Incrustar un activex en un formulario access

Soy un usuario novel de access, y necesito incrustar un activex estilo al explorer de windows, para poder guardar la ruta en la que se encuentran determinados ficheros. Mi problema está en que no se como hacerlo. Tengo el activex registrado, lo incrusto, pero no veo como hacerlo funcionar.

1 respuesta

Respuesta
1
Seguramente debe llevar ayuda sobre las clases que incorpora, métodos, propiedades, ejemplos de uso.
Al menos dime cómo se llama el componente.
Se llama sedirfile, y está en la página http://www.elguille.info/vb/utilidades/seldir/gsSelDirFile.htm, aunque me vale cualquier activex que cumpla la función de devolverme una ruta y un nombre de fichero determinado. Gracias por la velocidad en responderme. Un saludo.
Por lo que he estado mirando parece un componente para la web, no para access. De todas formas no lo conozco, yo para estas cosas me lo monto directamente con el treeview, o bien también puedes probar modificando el siguiente código, que es el que yo utilizo normalmente.
Creas un módulo nuevo y lo pegas ahí.
Option Explicit ' Obligar a declarar las variables antes de utilizarlas.
Option Compare Database ' Usar orden de la base de datos para las comparaciones de cadenas.
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Type MSA_OPENFILENAME
' Cadena de filtro usada para los filtros del cuadro de diálogo Abrir archivo.
' Utilizar MSA_CreateFilterString() para crearlo.
' Valor predeterminado = Todos los archivos, *.*
cadFiltro As String
' Filtro inicial a mostrar.
' Valor predeterminado = 1.
lngÍndiceFiltro As Long
' Directorio inicial al abrir el cuadro de diálogo.
' Valor predeterminado = Directorio de trabajo actual.
cadDirectorioInicial As String
' Nombre de archivo inicial para llenar el cuadro de diálogo.
' Valor predeterminado = "".
cadArchivoInicial As String
cadTítuloDeCuadroDeDiálogo As String
' Extensión predeterminada para anexar al archivo si el usuario no especificó ninguna.
' Valor predeterminado = Valores del sistema (Abrir archivo, Guardar archivo).
cadExtensiónPredeterminada As String
' Indicadores (ver lista de constantes) a utilizar.
' Valor predeterminado = sin indicadores.
lngIndicadores As Long
' Ruta completa del archivo seleccionado. Al abrir el archivo, si el usuario selecciona
' un archivo que no existe, sólo se devuelve el texto del cuadro "Nombre del archivo".
cadRutaCompletaDevuelta As String
' Nombre del archivo seleccionado.
cadNombreDeArchivoDevuelto As String
' Posición dentro de la ruta de acceso completa (cadRutaCompletaDevuelta) donde comienza
' el nombre del archivo (cadNombreDeArchivoDevuelto).
entPosiciónArchivo As Integer
' Posición dentro de la ruta de acceso completa (cadRutaCompletaDevuelta) donde comienza la extensión del archivo.
entExtensiónDeArchivo As Integer
End Type
Const ALLFILES = "Todos los archivos"
Type OPENFILENAME
lTamañoEstructura As Long
hwndPropietario As Long
hInstancia As Long
lpcadFiltro As String
lpcadFiltroPersonalizado As Long
nMáxFiltroCustr As Long
nÍndiceFiltro As Long
lpcadArchivo As String
nMáxArchivo As Long
lpcadTítuloArchivo As String
nMáxTítuloArchivo As Long
lpcadDirectorioInicial As String
lpcadTítulo As String
indicadores As Long
nPosiciónArchivo As Integer
nExtensiónArchivo As Integer
lpcadExtPredeterminada As String
lDatosCustr As Long
lpfnConexión As Long
lpNombrePlantilla As Long
End Type
Const NAA_PERMITIRMULTISELECCIÓN = &H200
Const NAA_CREARSÍMBOLOSISTEMA = &H2000
Const NAA_EXPLORADOR = &H80000
Const NAA_ARCHIVODEBEEXISTIR = &H1000
Const NAA_OCULTARSÓLOLECTURA = &H4
Const NAA_NOCAMBIARDIR = &H8
Const NAA_NODEREFERENCIARVÍNCULOS = &H100000
Const NAA_SINBOTÓNRED = &H20000
Const NAA_NODEVOLVERSÓLOLECTURA = &H8000
Const NAA_NOVALIDAR = &H100
Const NAA_SÍMBOLODELSISTEMASOBREESCRITURA = &H2
Const NAA_RUTADEBEEXISTIR = &H800
Const NAA_SÓLOLECTURA = &H1
Const NAA_MOSTRARAYUDA = &H10
Sub Ejemplo()
Dim pp As String
pp = BuscarMDB("prueba busq", "D:\Desarrollos\Coop2003\", "TpvSurtiV6Dat.mdb", , , "Todos (*.*)", "*.*")
If pp = "" Then pp = "Comillas"
MsgBox pp
End Sub
Function BuscarMDB( _
Optional cadTitulo As String = "indique el fichero...", _
Optional cadRutaBúsqueda As String = "", Optional cadArchivoBúsqueda As String = "", _
Optional cadFiltroTit As String = "Bases de datos Access(*.mdb,*.mde)", _
Optional cadFiltro As String = "*.mdb;*.mde", _
Optional cadFiltroTit2 As String = "", _
Optional cadFiltro2 As String = "") As String
' Mostrar el cuadro de diálogo Abrir archivo para que el usuario
Dim msaof As MSA_OPENFILENAME
' Establecer opciones para el cuadro de diálogo.
msaof.cadTítuloDeCuadroDeDiálogo = cadTitulo
msaof.cadDirectorioInicial = cadRutaBúsqueda
msaof.cadArchivoInicial = cadArchivoBúsqueda
msaof.cadFiltro = MSA_CreateFilterString(cadFiltroTit, cadFiltro, cadFiltroTit2, cadFiltro2)
' Llamar a la rutina del cuadro de diálogo Abrir archivo.
MSA_GetOpenFileName msaof
' Devolver la ruta de acceso y el nombre del archivo.
BuscarMDB = Trim(msaof.cadRutaCompletaDevuelta)
End Function
' Crear una cadena de filtro a partir de los parámetros pasados.
' Devolver "" si no pasa ningún parámetro.
' Esperar un número par de argumentos (nombre de filtro, extensión), pero si
' pasa un número impar, agregar *.*
Function MSA_CreateFilterString(ParamArray varFilt() As Variant) As String
Dim cadFiltro As String
Dim entDev As Integer
Dim entNúm As Integer
entNúm = UBound(varFilt)
If (entNúm <> -1) Then
For entDev = 0 To entNúm
cadFiltro = cadFiltro & varFilt(entDev) & vbNullChar
Next
If entNúm Mod 2 = 0 Then
cadFiltro = cadFiltro & "*.*" & vbNullChar
End If
cadFiltro = cadFiltro & vbNullChar
Else
cadFiltro = ""
End If
MSA_CreateFilterString = cadFiltro
End Function
' Crear una cadena filtro a partir de una cadena separada por barras ("|").
' La cadena debe tener parejas de filtro|extensión, por ejemplo "Bases de datos de Access|*.mdb|Todos los archivos|*.*"
' Si no existe ninguna extensión para el último filtro, se agrega *.*.
' Este código ignorará todas las cadenas vacías, por ejemplo "||".
' Devolver "" si las cadenas pasadas están vacías.
Function MSA_ConvertFilterString(strFilterIn As String) As String
Dim cadFiltro As String
Dim entNúm As Integer
Dim entPos As Integer
Dim entÚltimaPosición As Integer
cadFiltro = ""
entNúm = 0
entPos = 1
entÚltimaPosición = 1
' Agregar cadenas mientras se encuentren barras.
' Ignorar las cadenas vacías (no permitidas).
Do
entPos = InStr(entÚltimaPosición, strFilterIn, "|")
If (entPos > entÚltimaPosición) Then
cadFiltro = cadFiltro & Mid$(strFilterIn, entÚltimaPosición, entPos - entÚltimaPosición) & vbNullChar
entNúm = entNúm + 1
entÚltimaPosición = entPos + 1
ElseIf (entPos = entÚltimaPosición) Then
entÚltimaPosición = entPos + 1
End If
Loop Until (entPos = 0)
' Obtener la última cadena si existe (asumiendo que strFilterIn no terminaba con una barra).
entPos = Len(strFilterIn)
If (entPos >= entÚltimaPosición) Then
cadFiltro = cadFiltro & Mid$(strFilterIn, entÚltimaPosición, entPos - entÚltimaPosición + 1) & vbNullChar
entNúm = entNúm + 1
End If
' Agregar *.* si la última cadena no tiene extensión.
If entNúm Mod 2 = 1 Then
cadFiltro = cadFiltro & "*.*" & vbNullChar
End If
' Agregar NULL al final si hay algún filtro.
If cadFiltro <> "" Then
cadFiltro = cadFiltro & vbNullChar
End If
MSA_ConvertFilterString = cadFiltro
End Function
' Abrir el cuadro de diálogo Guardar archivo.
Private Function MSA_GetSaveFileName(msaof As MSA_OPENFILENAME) As Integer
Dim of As OPENFILENAME
Dim entDev As Integer
MSAOF_to_OF msaof, of
of.indicadores = of.indicadores Or NAA_OCULTARSÓLOLECTURA
entDev = GetSaveFileName(of)
If entDev Then
OF_to_MSAOF of, msaof
End If
MSA_GetSaveFileName = entDev
End Function
' Abrir el cuadro de diálogo Guardar archivo con los valores predeterminados.
Function MSA_SimpleGetSaveFileName() As String
Dim msaof As MSA_OPENFILENAME
Dim entDev As Integer
Dim cadDev As String
entDev = MSA_GetSaveFileName(msaof)
If entDev Then
cadDev = msaof.cadRutaCompletaDevuelta
End If
MSA_SimpleGetSaveFileName = cadDev
End Function
Function MSA_GetOpenFileName(msaof As MSA_OPENFILENAME) As Integer
' Abrir el cuadro de diálogo Abrir archivo.
Dim of As OPENFILENAME
Dim entDev As Integer
MSAOF_to_OF msaof, of
entDev = GetOpenFileName(of)
If entDev Then
OF_to_MSAOF of, msaof
End If
MSA_GetOpenFileName = entDev
End Function
' Abrir el cuadro de diálogo Abrir archivo con los valores predeterminados.
Function MSA_SimpleGetOpenFileName() As String
Dim msaof As MSA_OPENFILENAME
Dim entDev As Integer
Dim cadDev As String
entDev = MSA_GetOpenFileName(msaof)
If entDev Then
cadDev = msaof.cadRutaCompletaDevuelta
End If
MSA_SimpleGetOpenFileName = cadDev
End Function
' Este procedimiento convierte de la estructura Win32 a la estructura de MSAccess.
Private Sub OF_to_MSAOF(of As OPENFILENAME, msaof As MSA_OPENFILENAME)
msaof.cadRutaCompletaDevuelta = Left$(of.lpcadArchivo, InStr(of.lpcadArchivo, vbNullChar) - 1)
msaof.cadNombreDeArchivoDevuelto = of.lpcadTítuloArchivo
msaof.entPosiciónArchivo = of.nPosiciónArchivo
msaof.entExtensiónDeArchivo = of.nExtensiónArchivo
End Sub
' Este procedimiento convierte de la estructura de MSAccess a la estructura de Win32.
Private Sub MSAOF_to_OF(msaof As MSA_OPENFILENAME, of As OPENFILENAME)
Dim cadArchivo As String * 512
' Iniciar algunas partes de la estructura.
of.hwndPropietario = Application.hWndAccessApp
of.hInstancia = 0
of.lpcadFiltroPersonalizado = 0
of.nMáxFiltroCustr = 0
of.lpfnConexión = 0
of.lpNombrePlantilla = 0
of.lDatosCustr = 0
If msaof.cadFiltro = "" Then
of.lpcadFiltro = MSA_CreateFilterString(ALLFILES)
Else
of.lpcadFiltro = msaof.cadFiltro
End If
of.nÍndiceFiltro = msaof.lngÍndiceFiltro
of.lpcadArchivo = msaof.cadArchivoInicial & String$(512 - Len(msaof.cadArchivoInicial), 0)
of.nMáxArchivo = 511
of.lpcadTítuloArchivo = String$(512, 0)
of.nMáxTítuloArchivo = 511
of.lpcadTítulo = msaof.cadTítuloDeCuadroDeDiálogo
of.lpcadDirectorioInicial = msaof.cadDirectorioInicial
of.lpcadExtPredeterminada = msaof.cadExtensiónPredeterminada
of.indicadores = msaof.lngIndicadores
of.lTamañoEstructura = Len(of)
End Sub
Function ap_GetDatabaseProp(dbDatabase As Database, strPropertyName As String) As Variant
ap_GetDatabaseProp = dbDatabase.Containers!Databases _
.Documents("UserDefined").Properties(strPropertyName).Value
End Function
Sub ap_SetDatabaseProp(dbDatabase As Database, strPropertyName As String, varValue As Variant)
dbDatabase.Containers!Databases.Documents("UserDefined").Properties(strPropertyName).Value = varValue
End Sub
¿Y una vez tengo creado y modificado el módulo, que he de hacer para que se vea en el formulario? (Perdona mi gran ignorancia, pero como digo soy un principiante en access, así que imagina en VB) Y gracias de nuevo por la premura. Un saludo.
Para usarlo con el formulario sólo tienes que hacer las llamadas correspondientes desde un botón que tú le pongas.
Me da el siguiente error:
No se ha definido el tipo definido por el usuario.
En la siguiente función:
Function ap_GetDatabaseProp(dbDatabase As Database, strPropertyName As String) As Variant
ap_GetDatabaseProp = dbDatabase.Containers!Databases _
.Documents("UserDefined").Properties(strPropertyName).Value
End Function
Es una función de la API, no lo encontrarás en la ayuda. Ahora no recuerdo cómo va, pero hay bastante información por ahí.
También puedes echar mano de la apiguide, un programa muy bueno que encontré por internet hace tiempo.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas