My first adventure into re-linking is greeted with errors I don't understand. The intent of the code is to loop through the TableDefs deleting linked tables and then adding the tables back into the tables collection linking them to the BE named "ToDbName". I can't quite figure out what I'm doing wrong?
As trapped by my error code:
Code:Public Function ReLink(ToDbName As String) Dim db As DAO.Database Dim tdf As DAO.TableDef Dim strTableName As String Set db = CurrentDb For Each tdf In db.TableDefs On Error GoTo Err_Deletion strTableName = tdf.Name If Not (strTableName Like "MSys*" Or tdf.Name Like "~*") Then 'Ignore SYS & Temps If Len(CurrentDb.TableDefs(strTableName).Connect) > 0 Then 'Table linked? DoCmd.DeleteObject acTable, strTableName 'Yes, delete the link On Error GoTo Err_Linking Set tdf = db.CreateTableDef(strTableName) 'Create anew tdf.Connect = "; DATABASE=" & ToDbName 'Link to new BE db.TableDefs.Append tdf 'Append to TableDefs End If End If Next Set tdf = Nothing Set db = Nothing Exit Function Err_Deletion: MsgBox "Error encountered deleting the link to table " & strTableName & vbNewLine & _ "in database " & db.Name & vbNewLine & _ "Error #: " & Err.Number & ": " & Err.Description & vbNewLine & _ "Will attempt to continue processing." Resume Err_Linking: MsgBox "Error encountered linking to table " & strTableName & " in" & vbNewLine & _ "back-end database file: " & ToDbName & vbNewLine & _ "Error #: " & Err.Number & ": " & Err.Description & vbNewLine & _ "Sorry, cannot run application until this issue is resolved." DoCmd.Quit End Function