Preservar tablas vinculadas para Access DBs en la misma carpeta cuando la carpeta cambia

Question

Tengo dos bases de datos de Access que comparten tablas vinculadas. Se implementan juntos en un directorio y se accede a ellos a través de un código en forma de Word.

¿Cómo puedo asegurarme de que los enlaces se conservan cuando las dos bases de datos se copian (juntas) en una carpeta diferente? Como no estoy "abriendo" la base de datos, per se (se está accediendo a través de ADO), no sé cómo escribir código para actualizar los enlaces.

Answer 1

Actualización 14APR2009 Encontré que la respuesta anterior que di aquí era errónea, así que la actualicé con un código nuevo.

cómo proceder

• Copia el siguiente código para un módulo de VBA.

• De código o desde la ventana de inmediata en el IDE VBA, simplemente escriba:

  RefreshLinksToPath Application.CurrentProject.Path 
  

Esto ahora se vuelve a vincular todas las tablas vinculadas a utilizar el directorio donde se encuentra su aplicación.
Solo necesita hacerse una vez o cada vez que vuelva a vincular o agregar nuevas tablas.
Recomiendo hacer esto desde el código cada vez que inicie su aplicación.
Puede mover sus bases de datos sin problemas.

Código

'------------------------------------------------------------' 
' Reconnect all linked tables using the given path.   ' 
' This only needs to be done once after the physical backend ' 
' has been moved to another location to correctly link to ' 
' the moved tables again.         ' 
' If the OnlyForTablesMatching parameter is given, then  ' 
' each table name is tested against the LIKE operator for a ' 
' possible match to this parameter.       ' 
' Only matching tables would be changed.      ' 
' For instance:            ' 
' RefreshLinksToPath(CurrentProject.Path, "local*")   ' 
' Would force all tables whose ane starts with 'local' to be ' 
' relinked to the current application directory.    ' 
'------------------------------------------------------------' 
Public Function RefreshLinksToPath(strNewPath As String, _ 
    Optional OnlyForTablesMatching As String = "*") As Boolean 

    Dim collTbls As New Collection 
    Dim i As Integer 
    Dim strDBPath As String 
    Dim strTbl As String 
    Dim strMsg As String 
    Dim strDBName As String 
    Dim strcon As String 
    Dim dbCurr As DAO.Database 
    Dim dbLink As DAO.Database 
    Dim tdf As TableDef 

    Set dbCurr = CurrentDb 

    On Local Error GoTo fRefreshLinks_Err 

    'First get all linked tables in a collection' 
    dbCurr.TableDefs.Refresh 
    For Each tdf In dbCurr.TableDefs 
     With tdf 
      If ((.Attributes And TableDefAttributeEnum.dbAttachedTable) = TableDefAttributeEnum.dbAttachedTable) _ 
       And (.Name Like OnlyForTablesMatching) Then 
       collTbls.Add Item:=.Name & .Connect, key:=.Name 
      End If 
     End With 
    Next 
    Set tdf = Nothing 

    ' Now link all of them' 
    For i = collTbls.count To 1 Step -1 
     strcon = collTbls(i) 
     ' Get the original name of the linked table ' 
     strDBPath = Right(strcon, Len(strcon) - (InStr(1, strcon, "DATABASE=") + 8)) 
     ' Get table name from connection string ' 
     strTbl = Left$(strcon, InStr(1, strcon, ";") - 1) 
     ' Get the name of the linked database ' 
     strDBName = Right(strDBPath, Len(strDBPath) - InStrRev(strDBPath, "\")) 

     ' Reconstruct the full database path with the given path ' 
     strDBPath = strNewPath & "\" & strDBName 

     ' Reconnect ' 
     Set tdf = dbCurr.TableDefs(strTbl) 
     With tdf 
      .Connect = ";Database=" & strDBPath 
      .RefreshLink 
      collTbls.Remove (.Name) 
     End With 
    Next 
    RefreshLinksToPath = True 

fRefreshLinks_End: 
    Set collTbls = Nothing 
    Set tdf = Nothing 
    Set dbLink = Nothing 
    Set dbCurr = Nothing 
    Exit Function 

fRefreshLinks_Err: 
    RefreshLinksToPath = False 
    Select Case Err 
     Case 3059: 

     Case Else: 
      strMsg = "Error Information..." & vbCrLf & vbCrLf 
      strMsg = strMsg & "Function: fRefreshLinks" & vbCrLf 
      strMsg = strMsg & "Description: " & Err.Description & vbCrLf 
      strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf 
      MsgBox strMsg 
      Resume fRefreshLinks_End 
    End Select 
End Function 

Este código es una adaptación de esta fuente: http://www.mvps.org/access/tables/tbl0009.htm.
Quité toda la dependencia de otras funciones para que sea independiente, es por eso que es un poco más larga de lo que debería.

Answer 2

¿Se refiere a actualizar los enlaces dentro de su formulario de Word o los enlaces de tabla vinculados entre sus bases de datos de Access?

Para el primero, la mejor forma que conozco es mantener su (s) cadena (s) de conexión en el nivel del Módulo dentro de su documento de Word/proyecto de VBA y convertirlas en cadenas de texto. Luego, cuando establezca la cadena de conexión para sus objetos de conexión ADO, páselo a la const de cadena de conexión relativa.

Para este último, me sentiría tentado a utilizar una ruta relativa en la cadena de conexión a los datos dentro de cada base de datos de Access a la otra. Por ejemplo,

Dim connectionString as String 

connectionString = ";DATABASE=" & CurrentProject.Path & "\[Database Name Here].mdb" 

si como usted dice, las bases de datos se copian junto a una carpeta diferente (estoy asumiendo en la misma carpeta).

Answer 3

La respuesta de Renaud ya no funciona en Access 2010 con archivos Excel o CSV.

he hecho algunas modificaciones:

• Adaptado al modelo actual de la cadena de conexión
• manejó la ruta de la base de datos de forma diferente para los archivos de Excel (incluye el nombre de archivo) y archivos CSV (no incluye el nombre de archivo)

Aquí está el código:

Public Function RefreshLinksToPath(strNewPath As String, _ 
Optional OnlyForTablesMatching As String = "*") As Boolean 

Dim collTbls As New Collection 
Dim i As Integer 
Dim strDBPath As String 
Dim strTbl As String 
Dim strMsg As String 
Dim strDBName As String 
Dim strcon As String 
Dim dbCurr As DAO.Database 
Dim dbLink As DAO.Database 
Dim tdf As TableDef 

Set dbCurr = CurrentDb 

On Local Error GoTo fRefreshLinks_Err 

'First get all linked tables in a collection' 
dbCurr.TableDefs.Refresh 
For Each tdf In dbCurr.TableDefs 
    With tdf 
     If ((.Attributes And TableDefAttributeEnum.dbAttachedTable) = _ 
      TableDefAttributeEnum.dbAttachedTable) _ 
      And (.Name Like OnlyForTablesMatching) Then 
      Debug.Print "Name: " & .Name 
      Debug.Print "Connect: " & .Connect 
      collTbls.Add Item:=.Name & ";" & .Connect, Key:=.Name 
     End If 
    End With 
Next 
Set tdf = Nothing 

' Now link all of them' 
For i = collTbls.Count To 1 Step -1 
    strConnRaw = collTbls(i) 
    ' Get table name from the full connection string 
    strTbl = Left$(strConnRaw, InStr(1, strConnRaw, ";") - 1) 
    ' Get original database path 
    strDBPath = Right(strConnRaw, Len(strConnRaw) - (InStr(1, strConnRaw, "DATABASE=") + 8)) 
    ' Get the name of the linked database 
    strDBName = Right(strDBPath, Len(strDBPath) - InStrRev(strDBPath, "\")) 
    ' Get remainder of connection string 
    strConn = Mid(strConnRaw, InStr(1, strConnRaw, ";") + 1, InStr(1, strConnRaw, "DATABASE=") _ 
       - InStr(1, strConnRaw, ";") - 1) 

    ' Reconstruct the full database path with the given path 
    ' CSV-Files are not linked with their name! 
    If Left(strConn, 4) = "Text" Then 
     strDBPath = strNewPath 
    Else 
     strDBPath = strNewPath & "\" & strDBName 
    End If 

    ' Reconnect ' 
    Set tdf = dbCurr.TableDefs(strTbl) 
    With tdf 
     .Connect = strConn & "Database=" & strDBPath 
     .RefreshLink 
     collTbls.Remove (.Name) 
    End With 
Next 
RefreshLinksToPath = True 

fRefreshLinks_End: 
    Set collTbls = Nothing 
    Set tdf = Nothing 
    Set dbLink = Nothing 
    Set dbCurr = Nothing 
    Exit Function 

fRefreshLinks_Err: 
    RefreshLinksToPath = False 
    Select Case Err 
     Case 3059: 

     Case Else: 
      strMsg = "Error Information..." & vbCrLf & vbCrLf 
      strMsg = strMsg & "Function: fRefreshLinks" & vbCrLf 
      strMsg = strMsg & "Description: " & Err.Description & vbCrLf 
      strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf 
      MsgBox strMsg 
      Resume fRefreshLinks_End 
    End Select 
End Function 

Answer 4

I desafortunadamente todavía estoy en Access 2007. Comencé con uno de los bloques de código arriba que no funcionaba para mí. Al tener menos poder vba de acceso, lo simplifiqué solo al primer bucle que obtiene las rutas de la tabla y las actualiza en su lugar. El siguiente tipo que se encuentre con esto puede comentar o actualizar.

opción de comparación de bases de datos

'------------------------------------------------------------' 
' Reconnect all linked tables using the given path.   ' 
' This only needs to be done once after the physical backend ' 
' has been moved to another location to correctly link to ' 
' the moved tables again.         ' 
' If the OnlyForTablesMatching parameter is given, then  ' 
' each table name is tested against the LIKE operator for a ' 
' possible match to this parameter.       ' 
' Only matching tables would be changed.      ' 
' For instance:            ' 
' RefreshLinksToPath(CurrentProject.Path, "local*")   ' 
' Would force all tables whose ane starts with 'local' to be ' 
' relinked to the current application directory.    ' 
' 
' Immediate window type 
' RefreshLinksToPath Application.CurrentProject.Path 

'------------------------------------------------------------' 
Public Function RefreshLinksToPath(strNewPath As String, _ 
    Optional OnlyForTablesMatching As String = "*") As Boolean 

    Dim strDBPath As String 
    'Dim strTbl As String 
    'Dim strMsg As String 
    Dim strDBName As String 
    Dim dbCurr As DAO.Database 
    Dim dbLink As DAO.Database 
    Dim tdf As TableDef 

    Set dbCurr = CurrentDb 
    Dim strConn As String 
    Dim strNewDbConn1 As String 
    Dim strNewDbConn2 As String 
    Dim strNewDbConn As String 

    ' On Local Error GoTo fRefreshLinks_Err 

    'First get all linked tables in a collection' 
    dbCurr.TableDefs.Refresh 
    For Each tdf In dbCurr.TableDefs 
     With tdf 
      If ((.Attributes And TableDefAttributeEnum.dbAttachedTable) = TableDefAttributeEnum.dbAttachedTable) _ 
       And (.Name Like OnlyForTablesMatching) Then 

       strConn = tdf.Connect 
       strDBPath = Right(strConn, Len(strConn) - (InStr(1, strConn, "DATABASE=") + 8)) 
       strDBName = Right(strDBPath, Len(strDBPath) - InStrRev(strDBPath, "\")) 
       Debug.Print ("===========================") 
       Debug.Print (" connect is " + strConn) 
       Debug.Print (" DB PAth is " + strDBPath) 
       Debug.Print (" DB Name is " + strDBName) 

       strDBNewPath = strNewPath & "\" & strDBName 
       Debug.Print (" DB NewPath is " + strDBNewPath) 

       strNewDbConn1 = Left(strConn, (InStr(1, strConn, "DATABASE=") - 1)) 
       strNewDbConn2 = "DATABASE=" & strDBNewPath 
       strNewDbConn = strNewDbConn1 & strNewDbConn2 
       Debug.Print (" DB strNewDbConn is " + strNewDbConn) 

       'Change the connect path 
       tdf.Connect = strNewDbConn 
       tdf.RefreshLink 
      End If 
     End With 
    Next 
End Function