Dynamically Relink tables on open DB

[blindlemonray]

Hi, I am trying to dynamically link tables in my database based on the current file path. I have a front end with a separate backend DB. I would like to ensure when the front end is opened it relinks the tables based on the current file path. I am using the code below but getting an error:- "The Microsoft Access database engine cannot open the file <name>. It is already opened exclusively by another user, or you need permission to view its data."

Any help appreciated.

Dim dbs As DAO.Database
Dim tdf As DAO.TableDef

Set dbs = CurrentDb
For Each tdf In dbs.TableDefs
With tdf
If .Connect Like ";DATABASE=*" Then
.Connect = ";DATABASE=" & CurrentProject.Path
.RefreshLink
End If
End With
Next

 

[clapper62]

This is not my code I wish I could remember who to give credit to but I found it several months back

Private Function createAttached(strTable As String, strPath As String, strBaseTable As String) As Boolean
'************************************************************************************
'* Create an attached table in the current database from a table in a different MDB file.
'* In: *
'* strTable - name of linked table to create *
'* strPath - path and name of MDB file containing the table *
'* strBaseTable - name of table in strPath MDB *
'* Out: *
'* Return value: True/False, indicating success *
'* Modifies: *
'* Nothing, but adds a new table. *
'************************************************************************************
'On Error GoTo CreateAttachedError
Dim tdf As TableDef
Dim strConnect As String
Dim fRetval As Boolean
Dim myDB As Database
DoCmd.SetWarnings False
Set myDB = CurrentDb
Set tdf = myDB.CreateTableDef(strTable)

With tdf
.Connect = ";DATABASE=" & strPath
.SourceTableName = strBaseTable
End With

myDB.TableDefs.Append tdf

fRetval = True

DoCmd.SetWarnings True
CreateAttachedExit:
createAttached = fRetval
Exit Function
CreateAttachedError:
If Err = 3110 Then
Resume CreateAttachedExit
Else
If Err = 3011 Then
Resume Next
End If
End If

End Function

 

[blindlemonray]

Hi Clapper, nice code but no quite what i was after. I have the tables already linked, but some times we copy and move the front and back end. I would like some code to run so that I don't have to keep manually re-linking the tables to the current location.

Cheers

 

[dhookom]

Are you the only user in the file or is there another user? I would first add some debug.print to view the values.

Please use TGML code tags.

Dim dbs As DAO.Database
Dim tdf As DAO.TableDef

Set dbs = CurrentDb
For Each tdf In dbs.TableDefs
    With tdf
        If .Connect Like ";DATABASE=*" Then
            debug.print "Previous: " & .Connect    [COLOR=#4E9A06]'Show me previous[/color]
            .Connect = ";DATABASE=" & CurrentProject.Path
            .RefreshLink
            debug.print "New: " & .Connect         [COLOR=#4E9A06]'Show me new[/color]
        End If
    End With
Next

Duane
Vevey, Switzerland
Hook'D on Access
MS Access MVP 2001-2016

 

[blindlemonray]

nailed it.

'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 LnkDataBase As String
LnkDataBase = CurrentProject.Path & "\" & Mid(CurrentProject.Name, 10, 10) & " Performance_Workbench.accdb"
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" And Left(tdf.Connect, 5) <> "Excel" 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

 

[blindlemonray]

thanks for the assistance folks