Changing linked table location programmatically

问题:

I have an Access database with a linked table in a second database, located in the same directory as the first.

I would like to copy the whole directory to a new location (for testing) and have database one still link to the table in database two, but the linkage is still to the original directory, not the new location.

I'd like to do one of two things: either

1. Make the link to the table in database two in such a way that the folder path is relative - that the path to database two isn't hardcoded.

   or

2. Have a routine in Form_Load (or an autoexec macro) that checks the application.path and programmatically adjusts the linkage accordingly.

回答1:

It can be useful to have a start-up form that allows you to browse for the back-end you want and a table of the tables that should be linked. You could iterate through the tables collection, but i think a list is slightly safer. After that, a little code is all that is needed, here is a snippet:

''Connection string with database password 
strConnect = "MS Access;PWD=pw;DATABASE=" & Me.txtNewDataDirectory

Set rs = CurrentDb.OpenRecordset("Select TableName From LinkTables " _
& "WHERE TableType = 'LINK'")

Do While Not rs.EOF
    ''Check if the table is already linked, if it is, update the connection
    ''otherwise, link the table. 

    If IsNull(DLookup("[Name]", "MSysObjects", "[Name]='" & rs!TableName & "'")) Then
        Set tdf = db.CreateTableDef(rs!TableName, dbAttachSavePWD, _
            rs!TableName, strConnect)
        db.TableDefs.Append tdf
    Else
        db.TableDefs(rs!TableName).Connect = strConnect
    End If
    db.TableDefs(rs!TableName).RefreshLink
    rs.MoveNext
Loop

回答2:

Thanks,

I used it succesfull, however did not use it with the recordset.

Const LnkDataBase = "C:\NorthWind.mdb"
Sub relinktables()
'Routine to relink the tables automatically. Change the constant LnkDataBase to the desired one and run the sub
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim strTable As String
Set dbs = CurrentDb()
For Each tdf In dbs.TableDefs
    If Len(tdf.Connect) > 1 Then 'Only relink linked tables
        If tdf.Connect <> ";DATABASE=" & LnkDataBase Then 'only relink tables if the are not linked right
            If Left(tdf.Connect, 4) <> "ODBC" Then 'Don't want to relink any ODBC tables
                strTable = tdf.Name
                dbs.TableDefs(strTable).Connect = ";DATABASE=" & LnkDataBase
                dbs.TableDefs(strTable).RefreshLink
            End If
        End if
    End If
Next tdf
End Sub

回答3:

Our corporate IT changed the pathing our shared files from local to corporate, which necessitated redirecting all of our database tables. This would have a been pain, to delete and recreate all the links, especially with multiple different databases linked. I found this question but neither of the other answers worked well for me. The following is what I used. Note, this will take awhile with many tables as each update might take a few seconds.

Public Sub Fix_Table_Locations()
    Dim tbl As TableDef, db As Database, strConnect As String

    Set db = CurrentDb

    For Each tbl In db.TableDefs
        If InStr(tbl.Connect, "Portion of connect string to change") > 0 Then
            tbl.Connect = Replace(tbl.Connect, "Portion of connect string to change", "New portion of connect string")
            tbl.RefreshLink
        End If
    Next
End Sub

回答4:

I used usncahill's solution and modified it for my own needs. I do not have enough reputation to vote up their solution, so if you like my additional code, please vote us both up.

I wanted a quick way to switch between two back-end databases, one containing live data and the other containing test data. So I modified the previously mentioned code as follows:

Private Sub ReplaceLink(oldLink As String, newLink As String)
    Dim tbl As TableDef, db As Database

    Set db = CurrentDb

    For Each tbl In db.TableDefs
        If InStr(tbl.Connect, oldLink) > 0 Then
            tbl.Connect = Replace(tbl.Connect, oldLink, newLink)
            tbl.RefreshLink
        End If
    Next
End Sub

Public Function ConnectTestDB()
    ReplaceLink "Data.accdb", "Test.accdb"
End Function

Public Function ConnectLiveDB()
    ReplaceLink "Test.accdb", "Data.accdb"
End Function

Public Function TestDBSwitch()
    Dim tbl As TableDef, db As Database
    Dim wasData As Boolean
    Dim wasTest As Boolean

    wasData = False
    wasTest = False

    Set db = CurrentDb

    For Each tbl In db.TableDefs
        If InStr(tbl.Connect, "JGFC Flooring Data") > 0 Then
            wasData = True
        ElseIf InStr(tbl.Connect, "JGFC Flooring Test") > 0 Then
            wasTest = True
        End If
    Next

    If wasData = True And wasTest = True Then
        MsgBox "Data Mismatch.  Both Test and Live Data are currently linked! Connecting all tables to Test database. To link to Live database, please run again.", , "Data Mismatch"
        ConnectTestDB
    ElseIf wasData = True Then
        ConnectTestDB
        MsgBox "You are now connected to the Test database.", , "Connection Changed"
    ElseIf wasTest = True Then
        ConnectLiveDB
        MsgBox "You are now connected to the Live database.", , "Connection Changed"
    End If
 End Function

(The previous code assumes that both the Test and Live Data files are located in the same directory and the file name ends in Test and Data, but can be easily modified to other paths/filenames)

I call TestSwitchDB from a button in my front-end DB to quickly change between testing and production environments. My Access DB has user controls to switch between user environments, so when the admin user logs in to the front-end DB, I use the ConnectTestDB function directly to default the admin user to connect to the test DB. I likewise, use the ConnectLiveDB function when other users login to the front-end.

There is also a quick error detection in the TestSwitchDB function to tell me if there are a mix of connections to both environments prior to calling the switch function. If this error is recurrent, it could be a sign of other issues.