ms-access - una - importar dbf a access 2016

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

¿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 a nivel de Módulo dentro de su documento de Word / proyecto de VBA y convertirlas en cadenas de conexión. 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 usar 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 dices, las bases de datos se copian juntas en una carpeta diferente (supongo que en la misma carpeta).

Answer 2

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

Cómo proceder

• Copie el siguiente código en un módulo de VBA.

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

  RefreshLinksToPath Application.CurrentProject.Path

Esto volverá a vincular todas las tablas vinculadas para usar 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.
Luego 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 está adaptado de esta fuente: http://www.mvps.org/access/tables/tbl0009.htm .
Eliminé toda dependencia de otras funciones para que sea independiente, por eso es un poco más larga de lo que debería.

Answer 3

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

He hecho algunas modificaciones:

• Adaptado al patrón actual para la cadena de conexión
• Manejó la ruta de la base de datos de manera diferente para archivos de Excel (incluye nombre de archivo) y archivos CSV (no incluye 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

Desafortunadamente todavía estoy en Access 2007. Empecé con uno de los bloques de código de 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 Comparar base 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