![Antiguo](http://static.forosdelweb.com/fdwtheme/images/statusicon/post_old.gif)
08/08/2003, 01:45
|
| | Fecha de Ingreso: abril-2003 Ubicación: Madrid
Mensajes: 707
Antigüedad: 21 años, 10 meses Puntos: 0 | |
Diría que no, que mas bien tiene que ver con programación
Entiendo que están hablando de formularios de Access, y aunque tendría que ver con Bases de datos, es mas bien programación.
Ahora pongo el código, irá en dos mensajes, en uno solo no entra.
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
' ActualizarVínculosDeTabla '
' '
' Este módulo contiene funciones que actualizan '
' los vínculos a las tablas Neptuno si no están disponibles. '
' '
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
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
Function BuscarNeptuno(cadRutaBúsqueda) As String
' Mostrar el cuadro de diálogo Abrir archivo para que el usuario
' busque la base de datos Neptuno. Devolver la ruta completa a Neptuno.
Dim msaof As MSA_OPENFILENAME
' Establecer opciones para el cuadro de diálogo.
msaof.cadTítuloDeCuadroDeDiálogo = "¿Dónde está Neptuno?"
msaof.cadDirectorioInicial = cadRutaBúsqueda
msaof.cadFiltro = MSA_CreateFilterString("Bases de datos", "*.mdb")
' Llamar a la rutina del cuadro de diálogo Abrir archivo.
MSA_GetOpenFileName msaof
' Devolver la ruta de acceso y el nombre del archivo.
BuscarNeptuno = Trim(msaof.cadRutaCompletaDevuelta)
End Function
Function MSA_CreateFilterString(ParamArray varFilt() As Variant) As String
' 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 *.*
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
Function MSA_ConvertFilterString(strFilterIn As String) As String
' 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.
Dim cadFiltro As String
Dim entNúm As Integer, entPos As Integer, 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
Private Function MSA_GetSaveFileName(msaof As MSA_OPENFILENAME) As Integer
' Abrir el cuadro de diálogo Guardar archivo.
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
Function MSA_SimpleGetSaveFileName() As String
' Abrir el cuadro de diálogo Guardar archivo con los valores predeterminados.
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
Private 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
Function MSA_SimpleGetOpenFileName() As String
' Abrir el cuadro de diálogo Abrir archivo con los valores predeterminados.
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
Public Function ComprobarVínculos() As Boolean
' Comprobar los vínculos a la base de datos Neptuno. Devolver True si los vínculos son correctos.
Dim bd As Database, rst As Recordset
Set bd = CurrentDb
' Abrir la tabla vinculada para ver si la información de conexión es correcta.
On Error Resume Next
Set rst = bd.OpenRecordset("Productos")
' Si no se produce ningún error, devolver True.
If Err = 0 Then
ComprobarVínculos = True
Else
ComprobarVínculos = False
End If
End Function |