RE:Cuadro dialogo Abrir Fichero
Asi lo hago yo:
Private Sub Form_Open(Cancel As Integer)
Dim campo As String
On Error GoTo ErrorOpen
Me.RecordSource = "TBL Bancos"
ErrorOpen:
If Err.Number = 3024 Or Err.Number = 3043 Or Err.Number = 3044 Then
campo = VTAccess()
End If
Resume Next
End Sub
ESTA ES LA FUNCION
Function VTAccess() As Boolean
Dim ActualDB As Database
Dim EnlazarTabla As TableDef
Dim ModuloServidorFile As String
Dim Contador As Integer
ModuloServidorFile = OpenFile()
If ModuloServidorFile <> "" Then
VTAccess = True
Set ActualDB = CurrentDb()
For Contador = 0 To ActualDB.TableDefs.Count - 1
Set EnlazarTabla = ActualDB.TableDefs(Contador)
If EnlazarTabla.Connect <> "" Then
EnlazarTabla.Connect = ";DATABASE=" & ModuloServidorFile
Err = 0
EnlazarTabla.RefreshLink
If Err <> 0 Then
MsgBox "La conexión con el Módulo Servidor ha sido insatisfactoria." & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "'" & ModuloServidorFile & "' no contiene la tabla '" & EnlazarTabla.SourceTableName & "' requerida por la aplicación.", vbCritical + vbOKOnly, "Conexión con el Servidor"
VTAccess = False
Exit For
End If
End If
Next Contador
Else
MsgBox "La conexión con el Módulo Servidor ha sido cancelada.", vbCritical + vbOKOnly, "Conexión con el Servidor"
VTAccess = False
End If
End Function
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Private Function OpenFile() As String
Dim of As OPENFILENAME
of.hwndOwner = Application.hWndAccessApp
of.hInstance = 0
of.lpstrCustomFilter = 0
of.nMaxCustrFilter = 0
of.lpfnHook = 0
of.lpTemplateName = 0
of.lCustrData = 0
of.lpstrFilter = "Taquillas BD" & vbNullChar & "*.mde" & vbNullChar & vbNullChar
of.nFilterIndex = 1
of.lpstrFile = Left$("Taquillas BD.mde" & String$(512, 0), 512)
of.nMaxFile = 511
of.lpstrFileTitle = String$(512, 0)
of.nMaxFileTitle = 511
of.lpstrTitle = "Conectar servidor"
of.lpstrInitialDir = "C:\GESPER"
of.lpstrDefExt = ""
of.flags = OFN_EXPLORER + OFN_FILEMUSTEXIST + OFN_NOCHANGEDIR + OFN_PATHMUSTEXIST + OFN_HIDEREADONLY
of.lStructSize = Len(of)
If GetOpenFileName(of) Then
OpenFile = Trim(Left$(of.lpstrFile, InStr(of.lpstrFile, vbNullChar) - 1))
Else
OpenFile = ""
End If
End Function
MODULO CON LAS LAS VARIABLES
Option Compare Database
Option Explicit
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
Declare Function glrMoveWindows Lib "user32" Alias "MoveWindow" (ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWindth As Long, ByVal nHeight As Long, ByVal bRepair As Long) As Long
Global Const OFN_ALLOWMULTISELECT = &H200
Global Const OFN_CREATEPROMPT = &H2000
Global Const OFN_EXPLORER = &H80000
Global Const OFN_FILEMUSTEXIST = &H1000
Global Const OFN_HIDEREADONLY = &H4
Global Const OFN_NOCHANGEDIR = &H8
Global Const OFN_NODEREFERENCELINKS = &H100000
Global Const OFN_NONETWORKBUTTON = &H20000
Global Const OFN_NOREADONLYRETURN = &H8000
Global Const OFN_NOVALIDATE = &H100
Global Const OFN_OVERWRITEPROMPT = &H2
Global Const OFN_PATHMUSTEXIST = &H800
Global Const OFN_READONLY = &H1
Global Const OFN_SHOWHELP = &H10
Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As Long
nMaxCustrFilter 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
lCustrData As Long
lpfnHook As Long
lpTemplateName As Long
End Type
PD: Supongo que algunas variables no son necesarias, pero dejalas.
Algo largo el rollo, pero espero te sirva.