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
Function OpenCommDlg(Parametro As String, Optional Ruta)
On Error GoTo Err_TodoError
Dim Message$, FileName$, FileTitle$, DefExt$, Filter$
Dim Title$, szCurDir$, APIResults&
'
Select Case Parametro
 Case "0" ' Para abrir caja con ficheros graficos y de Word
  Filter$ = "Imágenes (GIF,PCX,BMP,JPG,DOC, RTF)" & Chr$(0) & "*.BMP;*.GIF;*.PCX;*.JPG;*.DOC;*.RTF;" & Chr$(0) & _
            "Todos los ficheros (*.*)" & Chr(0) & "*.*;" & Chr(0)
  Title$ = "Seleccionar imagen" & Chr$(0)
  DefExt$ = "BMP" & Chr$(0)   ' extensión por defecto
 Case "1" ' Para abrir bases de Datos 
  Filter$ = "Ficheros de Bases de Datos MDB, MDE" & Chr$(0) & "*.Mde;*.Mdb;" & Chr$(0)
  Title$ = "Seleccionar Fichero Vincula.MDB de datos..." & Chr$(0)
  DefExt$ = "MDB" & Chr$(0)
  szCurDir$ = Ruta
 Case "2"   ' para abrir ficheros con una extension determinada, extension INV, por ejemplo
  Filter$ = "Ficheros de inventario INV" & Chr$(0) & "*.Inv;" & Chr$(0)
  Title$ = "Seleccionar Fichero de Inventario" & Chr$(0)
  DefExt$ = "INV" & Chr$(0)
  szCurDir$ = Ruta
 Case Else
  ' para otras opciones
  
End Select



'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
Exit_TodoError:
    Exit Function

Err_TodoError:
    MsgBox "Aviso Nº: " & Err.Number & "  " & Err.Description, vbCritical + vbOKOnly, "PROGRAMA EJEMPLO"
    Resume Exit_TodoError
End Function