Ruta tablas vinculadas

[xavi]

Palabras clave: ruta, carpeta, directorio, tablas, vinculadas
Autor: Búho
Extraído de: La web del Búho

¿Cómo puedo saber la ruta completa de la MDB que contiene las tablas vinculadas de mi aplicación?

Código: [Seleccionar]

'*******************************************
'Francisco Garcia Aguado (Bhuo)
'Agosto de 2002



Function RutaVinculacionBD() As String
On Error GoTo Etiqueta_Error_Click
 
  'Referencio Base de datos actual: Hay dos métodos. Escoger el que se quiera
  '(A)
  'Set BaseDatosActual = OpenDatabase(CodeDb.Name)
  '(B)
  Set BaseDatosActual = CurrentDb
 
     '================================================
     'Recorro la colección de tablas de la base actual
     'buscando alguna Tabla Vinculada
     '================================================
     For VariableContadorInteger = 0 To BaseDatosActual.TableDefs.Count - 1
        If Left(BaseDatosActual.TableDefs(VariableContadorInteger).Name, 4) <> "MSys" Then
           
            If (BaseDatosActual.TableDefs(VariableContadorInteger).Attributes And dbAttachedTable) Or (BaseDatosActual.TableDefs(VariableContadorInteger).Attributes And dbAttachedODBC) Then
               
                CadenaNombreTablaVinculada = BaseDatosActual.TableDefs(VariableContadorInteger).Name
                StrRutaVinculacionBD = BaseDatosActual.TableDefs(CadenaNombreTablaVinculada).Connect
                StrRutaVinculacionBD = Mid(StrRutaVinculacionBD, 11, Len(StrRutaVinculacionBD))
                'si hemos entrado aquí es que ya tenemos la ruta de las tablas
                'vinculadas. La funcion devuelve la ruta de vinculacion
                RutaVinculacionBD = StrRutaVinculacionBD
                BaseDatosActual.Close
                Set BaseDatosActual = Nothing
                Exit Function
            End If
        End If
    Next VariableContadorInteger
    'Si llego aquí, es que esta base de datos no tiene Tablas Vinculadas
    RutaVinculacionBD = ""
    BaseDatosActual.Close
    Set BaseDatosActual = Nothing
Exit_Funcion:
 Exit Function
Etiqueta_Error_Click:
 MsgBox "Se ha producido el Error Nº: " & Err.Number & " ." & Err.Description, vbCritical + vbOKOnly, "Error de Datos"
 Resume Exit_Funcion
End Function