Palabras clave: referencias
Autor: Búho / Agosto 2002
Extraído de: La web del Búho

Objetivo:
Objetivo

Cita de: quien
Cuando ejecuto mi MDB en mi ordenador, todo funciona bien. Sin embargo si la traslado a otro PC, el usuario me indica que se producen errores, pues faltan Referencias a DLL u OCX dentro del  proyecto. ¿Como puedo controlar este tema desde código?


'Francisco J. García Aguado (Bhuo)
'Agosto de 2002



Function MiraReferenciasVBA()
    Dim Ref As Reference


   'Sacado de la ayuda de Access para ver si se ha
   'roto alguna referencia del proyecto de VBA.
   'Bhúo, Agosto de 2002

   'Puede servir para cuando distribuyamos una aplicación
   'con referencias externas a funciones inmersas en: OCX,DLL, MDE, MDB...)
   'que nosotros en el proyecto hemos referenciado desde una determinada ubicación
   'local de nuestro PC y a la hora de ejecutar el programa el usuario, pueda dar errores
   'por no tener dichas referencias o tenerlas en otra ubicación distinta
   'y de esta forma el usuario nos pueda avisar de esta contingencia.
   'Esta función se puede poner en el formulario de inicio de la aplicación
   'para avisar al usuario de este tema.

    For Each Ref In References
       
        If Ref.IsBroken = False Then
         ' este msgbox es puramente informativo de las referencias que están OK
         ' y es para probar este código.
         MsgBox "Nombre de la Referencia: " & Ref.Name & vbCrLf _
          & "En la ruta: " & Ref.FullPath & vbCrLf _
          & "Versión de la Referencia: " & Ref.Major & "." & Ref.Minor, vbInformation + vbOKOnly, "Referencias en VBA"
        Else
         ' referencia rota
          MsgBox "Nombre de la Referencia rota:" & Ref.Name & vbCrLf _
           & "Ruta Origina: " & Ref.FullPath & vbCrLf _
           & "GUID completo de la Referencia: " & Ref.Guid, vbCritical + vbOKOnly, "AVISO: Servicio de mantenimiento del programa 95-22222222."
         'aquí la acción a seguir...
         
         'Sacado también de la ayuda de Access.
         'En este ejemplo, se podría poner ruta completa, mediante
         'un dialogo de Windows e intentar referenciar de nuevo
         'la referencia rota o bien abandonar la aplicación.
         'En este caso ponemos una ruta fija que sirva de ejemplo:
         'C:\Windows\System\Mscal.ocx
         'Recordar que el nombre y Path original de la referencia
         'sería ref.FullPath
         If CrearNuevaReferencia("C:\Windows\System\Mscal.ocx") = False Then
          MsgBox "No se ha podido regenerar la referencia.", vbCritical + vbOKOnly, "Aviso"
         Else
          MsgBox "La Referencia, " & Ref.FullPath & " se ha establecido correctamente.", vbExclamation + vbOKOnly, "Correcto"
         End If
        End If
    Next Ref
End Function

'***************************************
Function CrearNuevaReferencia(PathCompletoFichero As String) As Boolean
    Dim Ref As Reference

    On Error GoTo Error_CrearNuevaReferencia
    Set Ref = References.AddFromFile(PathCompletoFichero)
    CrearNuevaReferencia = True

Exit_CrearNuevaReferencia:
    Exit Function

Error_CrearNuevaReferencia:
    MsgBox "Aviso Nº: " & Err & "..." & Err.Description & " [" & PathCompletoFichero & "]", vbCritical + vbOKOnly, "Aviso de Error"
    CrearNuevaReferencia = False
    Resume Exit_CrearNuevaReferencia
End Function



Palabras clave: abrir, informe, reporte, primer, plano, modar, emergente
Autor: Búho / Agosto 2002
Extraído de: La web del Búho

Cita de: quien
Cuando abro un reporte en vista previa desde un formulario Modal o Emergente, éste se sitúa detrás del formulario y no puedo verle. ¿Como presento el reporte en pantalla, por delante del formulario?

Cita de: Búho
Esto sirve para meter un report en vista previa, llamado desde un formulario MODAL. Si se hace sin mas, el Report se queda en segundo plano y no se ve.
Búho Agosto 2002
Uso:
En vez de llamar al reporte de forma habitual, lo hacemos desde esta función. Es decir, desde cualquier formulario, que deseemos lanzar un 'reporte en vista previa, con formularios modales y para evitar que dicho 'reporte se quede 'detrás' y no se vea, deberemos llamar así: OpenReport("Mireporte", etc)

Y la funcion OpenReport que hace todo esto es:

Código [Seleccionar] Expandir


Sub OpenReport(ReportName As String, Optional View As Integer, Optional _
    FilterName As String, Optional WhereCondition As String)
Dim loFormArray() As String
Dim loform As Form
Dim intCount As Integer
Dim intX As Integer
    For Each loform In Forms
        If loform.Visible Then
            ReDim Preserve loFormArray(intCount)
            loFormArray(intCount) = loform.Name
            loform.Visible = False
            intCount = intCount + 1
        End If
    Next
    DoCmd.OpenReport ReportName, View, FilterName, WhereCondition
    Do While IsVisible(acReport, ReportName): DoEvents: Loop
    For intX = intCount - 1 To 0 Step -1
        Forms(loFormArray(intX)).Visible = True
    Next
End Sub

Function IsVisible(intObjType As Integer, strObjName As String) As Boolean
Dim intObjState As Integer
    intObjState = SysCmd(acSysCmdGetObjectState, intObjType, strObjName)
    IsVisible = intObjState And acObjStateOpen
End Function


Palabras clave: al no estar en lista, NotInList, cuadro combinado, combo, combobox
Autor: Autores
Extraído de: La web del Búho

Objetivo:
Controlar un valor inexistente en un cuadro combinado para que se almacene en la tabla.

Descarga el ejemplo de la web del Búho

Mejora de Happy para controlar cuando debe insertarse más de un campo.

Cita de: Happy
Tengo un formulario Cuentas, en el cual tengo un comboCliente (basado en la tabla Clientes, con dos columnas IdCliente, NombreCompañia, solo la segunda columna es visible). Cuando creo una nueva cuenta debo asignársela a algún cliente mediante ese combo, pero cuando el cliente todavía no lo he creado se activa el evento NotInList (el cliente inexistente no está en la lista del combo).

Entonces tengo éste código:

Código [Seleccionar] Expandir


Private Sub Cliente_NotInList(NewData As String, Response As Integer)
Dim Nuevocli As Integer, entTruncarNombre As Integer, txtTítulo As String,entMsjDiálogo As Integer
Dim nuevo As String
Nuevocli = msgbox("¿Desea agregar un nuevo cliente?", vbOKCancel)
If Nuevocli = vbOK Then
nuevo = "nuevo" 
DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70
DoCmd.OpenForm "clientes", acNormal, , , acAdd, , [nuevo]
Forms!clientes!NombreCompañia = NewData   
Response = acDataErrContinue 
End If
End Sub


Así abro el formulario Clientes, en el cual ingreso todos los datos del cliente nuevo, al abrirse el campo NombreCompañia ya estará lleno con el dato que ingresé en el combo,  al terminar de escribir los datos cierro el formulario y en evento Unload tengo éste código:

Código [Seleccionar] Expandir


Private Sub Form_Unload(Cancel As Integer)
Dim ctl As Control   
If  Me.OpenArgs = "nuevo" Then 
  Set ctl = Forms!cuentas!Cliente 
  DoCmd.SelectObject acForm, "cuentas"
  ctl = Me!IdCliente 
  ctl.Requery
  ctl.SetFocus
End If
End Sub


Palabras clave: exportar, tabla. fichero, archivo, texto, plano
Autor: Búho
Extraído de: La web del Búho

Objetivo:
Exportar a un fichero de texto plano el resultado de una tabla con el objeto de poderlo utilizar en otras aplicaciones.


Descarga el ejemplo de la web del Búho

Palabras clave: recorrer, colección, objetos, base, externa, remota
Autor: Búho y Happy
Extraído de: La web del Búho

Cita de: Búho
Juan:
Me estoy haciendo un poco de lío. Se nota que estoy oxidado con Access despues de varios meses de haber dejado de forma efectiva la programación. Se notó antes de ayer con la función que me comentaste tú y Marjan.

Me planteo el siguiente caso:
Desde MDB1 deseo comprobar que en MDB2 existe un Reporte XXX
¿Como recorro los nombres de los objeto Reports de dicha MDB2?
Desde la actual, lo tengo claro con:

dbs As Object
   
Set dbs = Application.CurrentProject
'Aplicacion de esta, por ejemplo:

' Busca objetos AccessObject abiertos en la colección AllReports..
  For Each obj In dbs.AllReports
   msgbox obj.Name
  Next obj


Al hilo de todo esto, tengo en mi cabeza las siguientes referencias sobre apertura y referencias a una MDB

Dim wrk As Workspace
Dim dbs1 As Database
Set wrk = DBEngine.CreateWorkspace("", "Admin", "")
Set dbs1 = wrk.OpenDatabase("RutaDestinoBase)

Esta es la primera forma. Bien...¿Cuando se emplea? ¿Cuando es conveniente abrirla así?

   
OTRA
Dim BaseDestino As New Access.Application
Set BaseDestino = New Access.Application
BaseDestino.OpenCurrentDatabase "Destino"
BaseDestino.CloseCurrentDatabase
Set BaseDestino = Nothing

¿Esta forma anterior cuando y por qué? ¿Diferencias y analogías con la anterior?
   
OTRA
Dim obj As AccessObject, dbs As Object
   
Set dbs = Application.CurrentProject
'Aplicacion de esta, por ejemplo:

' Busca objetos AccessObject abiertos en la colección AllReports..
  For Each obj In dbs.AllReports
   msgbox obj.Name
  Next obj


Tengo un poco de lío al respecto. ¿Me puedes aclarar un poco el tema?

Cita de: la respuesta de Juan
Hola Francisco,

Tú dices:

"Me planteo el siguiente caso: Desde MDB1 deseo comprobar que en MDB2 existe un Reporte XXX ¿Como recorro los nombres de los objeto Reports de dicha MDB2?..."

respuesta:

Function VerReportes(BDatos As String)
Dim objAcc As New Access.Application
Dim rpt As AccessObject

  objAcc.OpenCurrentDatabase BDatos

  With objAcc
  For Each rpt In .CurrentProject.AllReports
    Debug.Print rpt.Name
  Next
  End With

  objAcc.CloseCurrentDatabase

  Set objAcc = Nothing

End Function

Tú preguntas:

"Dim wrk As Workspace
Dim dbs1 As Database
Set wrk = DBEngine.CreateWorkspace("", "Admin", "")
Set dbs1 = wrk.OpenDatabase("RutaDestinoBase)

Esta es la primera forma. Bien...¿Cuando se emplea? ¿Cuando es conveniente abrirla así?... "

Respuesta:

De esta manera estás abriendo la base de datos a través de la librería DAO y accederás a toda la jerarquía DAO (empezando con DBEngine, Workspace, Database, etc.) y todas sus propiedades, métodos y colecciones).

Tú preguntas:

"Dim BaseDestino As New Access.Application
Set BaseDestino = New Access.Application
BaseDestino.OpenCurrentDatabase "Destino"
BaseDestino.CloseCurrentDatabase
Set BaseDestino = Nothing

¿Esta forma anterior cuando y por qué? ¿Diferencias y analogías con la anterior?..."

Respuesta:

De esta otra forma abres una base de datos desde el objeto application, es decir, desde el mismo programa de Access, es como si tuvieras una ventana con la base de datos abierta (puedes tenerla o no, según quieras). De esta manera accederás a todos las colecciones, métodos, propiedades y objetos que posee el objeto application (que no son los mismos que con DAO). Tú decides en cada momento, cuál de las dos formas de abrir la base de datos te proporcionará la funcionalidad que necesitas. En el caso concreto que preguntabas es méjor acceder a la colección AllForms de CurrentProject del objeto Application, ya que contiene TODOS los informes (estén abiertos o no).

Tú preguntas:

"OTRA
Dim obj As AccessObject, dbs As Object

Set dbs = Application.CurrentProject
'Aplicacion de esta, por ejemplo:

' Busca objetos AccessObject abiertos en la colección AllReports..
  For Each obj In dbs.AllReports
   msgbox obj.Name
  Next obj..."

Respuesta:

Aquí lo único que se diferencia de la primera es que no declaras dbs como AccessObject (que sería lo correcto), y lo declaras como Object (es decir, cualquier tipo de Objeto).

Aprovechando que tiene que ver con esto último, te comento algo que ya le comenté a McPegasus el otro día. Es un detalle tonto, pero creo que muy útil.

Imagínate que quieres hacer una rutina para rellenar un documento de Word o de Excel, desde Access. Lo normal es que empezaras declarando una variable tipo Word.Application o Excel.Application. Bien. De esta manera, podrás usar a través de esta variable la librería de objetos de Word o Excel (previa señalización en el cuadro referencias, claro). La cosa vendría a ser algo
así:

Dim appWord as New Word.Application

    appWord.open Documents = "C:\doc1.doc" (o algo así, que no me acuerdo)
... ...

Pequeño truco:

Para escribir el código, hazlo como indico arriba. Será fácil y documentado por el examinador de objetos con el operador "." (punto). Una vez probado que todo funcione correctamente, rehaz la declaración de variables y añade una nueva línea al código:

Dim appWord as Object

    Set appWord = CreateObject("Word.Application")

haciendo esto, puedes quitar la referencia a la librería de objetos de Word, ahorrando una referencia al programa (se abrirá una referencia implícita sólo cuando uses esa rutina), y sin embargo todo funcionará correctamente.

Creo que esta es una de las utilidades de usar variables Object (génericas). En el resto de los casos, lo mejor es declarar las variables con su tipo correcto. Puede que hayan casos en que de lo mismo, pero es más que nada como buena costumbre de programación



Saludos desde BCN
happy

Palabras clave: mde
Autor: Búho... y muchos otros
Extraído de: La web del Búho

Cita de: alguien que preguntó
¿Es posible importar, exportar, realizar algún cambio en un fichero MDE?.

Respuesta
NO, NO y NO. NO se puede

Palabras clave: usuarios, control, impresión, copias
Autor: Búho
Extraído de: La web del Búho

Objetivo:
Controlar qué usuarios y cuantas páginas imprimen de los reportes en un entorno de Red

Responde el Búho]
Se me ocurre una idea que no sé si será factible, pero se podría intentar desarrollar.
Según creo entender en tu pregunta, (Es un supuesto) dispones de una aplicacion que corre en RED, donde existen varios puestos de trabajo y un servidor (Tu Pc) en el cual están las tablas vinculadas de la aplicacion y la impresora.
Si eso es cierto, podrías crear una tabla más vinculada que se llamara por ejemplo:
ControlImpresion

con los campos:
Nombre_Usuario_PC
Nombre_Reporte
Numero_paginas_Imprimidas

Bien. Ahora en cada reporte (En todos) deberías poner el siguiente código y en lo siguientes eventos:



Option Compare Database
Option Explicit
Dim Paginas As Integer

Private Sub Report_Page()
Paginas = Paginas + 1
End Sub
Private Sub Report_Close()
'Aqui llamamos a una funcion que rellene los datos para control
EscribeDatosReportes(Paginas, Me.Name)
End Sub



En un modulo crea la función:


Function EscribeDatosReporte(NumPag as Integer, NombreRepor As String)
'Ahora debes abrir el recordset de la tabla ControlImpresion
Dim SqlF As String
Dim RstF As Recordset
SqlF = "Select * from ControlImpresion"
Set RstF = CurrentDb.OpenRecordset(SqlF, dbOpenDynaset)
With RstF
        .AddNew
        !Nombre_Reporte = NombreRepor
        !Numero_paginas_Imprimidas= NumPag
        !Nombre_Usuario_PC= DamePcUsuario()
       .Update
End With
RstF.Close
End Function


De esta forma en tu tabla siempre tendrás constancia de lo que imprimen. He supuesto que los reportes se imprimen todos, es decir, que no hay ninguno que se puedan ver en 'vista previa', pues de otra forma, también se desencadenarían los eventos y se escribiría en la tabla como imprimidos algo que solo se ha visualizado.
Pero creo que para empezar, es una idea que se puede desarrollar.

Y falta explicarte lo de la función DamePcUsuario(). Sería una función que leyera el ldb de la base de cada usuario.
Mas o menos esto:


Function DamePcUsuario() As String
Dim str As String
str = CurrentDb.Name '(Base de datos a consultar, esta u otra)
Dim Usuario As String
If Dir(str) <> "" Then
str = Left(str, Len(str) - 3) & "ldb"
Open str For Input As #1
Usuario = Input$(36, #1)
DamePcUsuario=Usuario
Else
DamePcUsuario=""
End If
End Function


Nota de Xavi: Si no me equivoco, esa última función se puede sustituir por un Environ("UserName") mucho más "limpio"

Al salir, en Usuario tendrías el nombre del usuario y de la maquina. Revisa el código pues yo no le he probado. La idea es esta. Ya nos contaras que tal.

Palabras clave: cambiar, modificar, establecer, definir, márgenes, informe, reporte
Autor: Búho
Extraído de: La web del Búho

Objetivo:
Definir los márgenes de un informe en tiempo de ejecución.



Option Compare Database
Type cadena
    cadRGB As String * 28
End Type

Type margenes
    xMargenIzquierdo As Long
    yMargenSuperior As Long
    xMargenDerecho As Long
    yMargenInferior As Long
   
End Type

Sub diseño(nombreinf As String)       'función para cambiar margenes en informes
    Dim MargenesInf As cadena
    Dim PM As margenes
    Dim rpt As Report
    DoCmd.OpenReport nombreinf, acViewDesign
    Set rpt = Reports(nombreinf)
    MargenesInf.cadRGB = rpt.PrtMip    'guardo los margenes informe
    LSet PM = MargenesInf
    PM.xMargenIzquierdo = 1400    ' Establece los márgenes.
    PM.yMargenInferior = 600
    PM.xMargenDerecho = 1400
    PM.yMargenSuperior = 800
    LSet MargenesInf = PM                ' Actualiza la propiedad.
    rpt.PrtMip = MargenesInf.cadRGB
    DoCmd.Close acReport, nombreinf, acSaveYes  'guardo sin preguntar
End Sub

Function diseñoimprimir(nombreinf As String)       'función para cambiar margenes en informes

    Dim MargenesInf As cadena
    Dim PM As margenes
    Dim rpt As Report
    Set rpt = Reports(nombreinf)
    MargenesInf.cadRGB = rpt.PrtMip    'guardo los margenes informe
    LSet PM = MargenesInf
    PM.xMargenIzquierdo = 1400    ' Establece los márgenes.
    PM.yMargenInferior = 10000
    PM.xMargenDerecho = 1400
    PM.yMargenSuperior = 800
    LSet MargenesInf = PM                ' Actualiza la propiedad.
    rpt.PrtMip = MargenesInf.cadRGB
   ' DoCmd.OpenReport nombreinf, acViewNormal
   
End Function


Palabras clave: exportar, extraer, datos, contaplus
Autor: Recogido por Búho
Extraído de: La web del Búho

Lista de especificaciones para exportar datos.
Ojo: Segun las propiedades del documento este es del 2001 así que el tema puede haber cambiado un poco.

Descarga el archivo (un PDF dentro de un ZIP) de la web del Búho

Palabras clave: vinculación, tablas
Autor: Búho
Extraído de: La web del Búho

Cita de: alguien que preguntó
Yo tengo mi aplicación separada en formularios y en tablas, en sendas bases de datos diferentes. ¿Como puedo controlar al iniciar mi aplicación, si la ruta de vinculación es correcta y en caso de que no lo sea, revincular hacia otra ruta predeterminada?


'Francisco García Aguado (bhuo)
'Agosto de 2002
'Proceso:
'Se trata de una base de datos Aplicacion.Mdb que tiene tablas vinculadas en una ruta
'concreta, por ejemplo C:\RutaDatos\Datos.mdb
'Si se cambia de ubicacion el modulo de datos, los puestos de trabajo en RED cuando
'ejecuten sus respectivos programas, caeran en error, pues la ruta de los
'datos ha cambiado
'¿Que hacer?
' Primero se intenta abrir una tabla vinculada cualquiera. En este ejemplo
'la tabla se llama 'Vincula'
'Si la vinculacion esta OK, se continua con la carga normal del programa
'Si la vinculacion se ha roto, se invita al usuario a escoger
'nueva ruta de vinculacion y consecuentemente se refrescan los link's
'hacia esa nueva ruta.
'ES MUY CONVENIENTE QUE TODOS IMPLEMENTEIS ESTE TIPO DE SISTEMA
'DE ALERTA EN CUALQUIER APLICACION QUE TENGA SEPARADOS LOS FORMULARIOS
' DE LOS DATOS.

'En el formulario de inicio de la aplicacion, lo primero que se hace es llamar
' a la funcion Comprobar() escrita esn este nodulo
'Comenzamos....



Option Compare Database
Option Explicit


'=================Comprobar Vinculos================
Public Function Comprobar()
'Esta funcion es llamada nada mas arrancar la aplicacion, antes de cargar ningun
'objeto de Acces. La carga se realizará bien desde una macro
'autoexec, bien desde el primer formulario de inicio de la aplicacion.-
'Escojo al hazar cualquier tabla vinculada de la aplicacion.
'Intento abrirla, si puedo...
'Si la vinculacion es OK, no se desencadena ningun evento, simplemente
'se sale de la función y continua la carga del programa normalmente.-
'Si me da error:
'la vinculacion se ha roto (Errores nº3024,3044)
'Al saltar a la rutina de tratamientos de errores, se desencadena
'todo el proceso de Vincular de nuevo los chismes con los datos..

On Error GoTo Err_Comando7_Click
Dim dbs As Database
Dim Rst As Recordset
Set dbs = CurrentDb
' en este caso Vincula es una tabla vinculada...intento abrirla...
Set Rst = dbs.OpenRecordset("Select * from Vincula", dbOpenDynaset)
Rst.Close
dbs.Close
'Si llego aquí es que la vinculacion, al menos de las tablas antiguas, esta bien....
'y me salgo de esta funcion para continuar con la carga normal del programa
MsgBox "Las tablas están perfectamente vinculadas", vbInformation + vbOKOnly, "AVISO"
Exit_Comando7_Click:
    Exit Function

Err_Comando7_Click:
   
    If Err.Number = 3024 Or Err.Number = 3044 Then
     ' Se ha roto la vinculación...llamo a la rutina para
     'revincular...
     VincularTablas
     Exit Function
    End If
    MsgBox "El proceso NO HA TENIDO EXITO: 983-000000", vbCritical + vbOKOnly, "Servicio de Mantenimiento."
    ' Salida de la aplicación
    Exit Function
    Resume Exit_Comando7_Click
End Function

'======Funcion que refresca los Links

Function VincularTablas()
On Error GoTo Err_Comando7_Click
Dim Ejecuta As String
       If MsgBox("El programa no ha podido encontrar los Datos de la Aplicación." & Chr(13) _
          & "Las posibles causas pueden ser, que bien el módulo de datos se ha borrado" & Chr(13) _
          & "o bien que Vd. está trabajando en RED y es necesario VINCULAR los datos desde" & Chr(13) _
          & "este puesto de trabajo. Si lo desea, puede ponerse en contacto con el " & Chr(13) _
          & "servicio de Mantenimiento del programa: 983-000000", vbCritical + vbYesNo, "FALTAN LOS DATOS") = vbYes Then
        MsgBox "Hemos visto como el propio programa ha detectado una tabla, la cual se ha roto" & Chr(13) & Chr(10) _
            & "su vinculación. En concreto la base de datos se llama Vincula.Mdb y deberá buscarla" & Chr(13) & Chr(10) _
            & "en su disco duro, entorno de red etc. Una vez escogida, se realiza la RE-vinculación" & Chr(13) & Chr(10) _
            & "de forma automática. Ahora pulse aceptar para seguir con el proceso.", vbInformation + vbOKOnly, "Esto ha funcionado bien"
        Dim objAcObj As AccessObject
        Dim objCurData As CurrentData
        Dim DBSS As Database
        Set objCurData = Application.CurrentData
        Dim RutaFichero As String
        Dim Tabla As TableDef
        'En la siguiente línea llamamos al OpenCommDlg para que el usurio interaciones
        'con el programa y escoja la nueva ruta donde se encuentran
        'las tablas vinculadas, bien en el PC actual, bien en el entorno de RED
        'AQUI:
        RutaFichero = OpenCommDlg(CurrentProject.Path)

        If Len(RutaFichero) <> 0 Then
         Set DBSS = CurrentDb()
         For Each objAcObj In objCurData.AllTables
          Set Tabla = DBSS.TableDefs(objAcObj.Name)
          If Tabla.Attributes And dbSystemObject Or Tabla.Name = "Ayuda" Or Tabla.Name = "barras" Or Tabla.Name = "clientedocumentos" Or Tabla.Name = "clientes" Or Tabla.Name = "codificaciones" Or Tabla.Name = "excel" Or Tabla.Name = "menu1" Or Tabla.Name = "menu2" Or Tabla.Name = "menu3" Or Tabla.Name = "menu4" Or Tabla.Name = "reemplazacodigos" Or Tabla.Name = "reporteimpresora" Or Tabla.Name = "Almacen" Or Tabla.Name = "menus" Then
          'en este if quito las tablas del sistema y todas aquellas que sean locales
          'que obviamente no son necesarias vincular.
          'En nuestro caso, las locales son las citadas anteriormente
          'ya que la MDB puede tener tablas locales (Que obviamente no son precisas vincular).
          'y tener tablas vinculadas, que son las que se recogerían
          'en el ELSE siguiente.
          Else
           Tabla.Connect = ";DATABASE=" & RutaFichero
           Tabla.RefreshLink
          End If
         Next objAcObj
         MsgBox "El proceso ha concluido con éxito. Ya tiene de nuevo vinculada" & Chr(13) _
              & "la tabla VINCULA de la base de datos Vincula" & Chr(13) _
              & "La Ruta de sus datos es: " & RutaFichero, vbInformation + vbOKOnly, "Proceso Concluido"
         Exit Function
        End If
       Else
        'código de salida de la aplicacion pues el proceso no ha concluido con exito.
       Quit
       End If
Exit_Comando7_Click:
Exit Function
Err_Comando7_Click:
MsgBox "Se ha producido el Error Nº: " & Err.Number & " ." & Err.Description, vbCritical + vbOKOnly, "Error de Datos"
Resume Exit_Comando7_Click
End Function


'=================Funcion para abrir el dialogo de Windows
'=================y que el usuario escoja ruta de vinculacion
'Al ser funciones de proposito general, esto se puede incluir
'perfectamente en otro modulo independiente



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(Ruta)
On Error GoTo Err_TodoError
Dim Message$, FileName$, FileTitle$, DefExt$, Filter$
Dim Title$, szCurDir$, APIResults&
'

  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


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