'
'Link All Tables From Back End Database
'
'The function LinkTables creates links to all the tables in the remote database.
'The DbPath parameter should contain the complete path and database name.
'The subroutine CallLinkTables has sample code to call the function.


Function LinkTables(DbPath As String) As Boolean
'This links to all the tables that reside in DbPath, whether or not they already reside in this database.
'This works when linking to an Access .mdb file, not to ODBC.
'This keeps the same table name on the front end as on the back end.

Dim rs As Recordset

    On Error Resume Next

'get tables in back end database
    Set rs = CurrentDb.OpenRecordset("SELECT Name " & _
                                    "FROM MSysObjects IN '" & DbPath & "' " & _
                                    "WHERE Type=1 AND Flags=0")
    If Err <> 0 Then Exit Function

'link the tables
    While Not rs.EOF
        If DbPath <> Nz(DLookup("Database", "MSysObjects", "Name='" & rs!Name & "' And Type=6")) Then
            'delete old link, assuming front and back end table have the same name
            DoCmd.DeleteObject acTable, rs!Name
            'make new link
            DoCmd.TransferDatabase acLink, "Microsoft Access", DbPath, acTable, rs!Name, rs!Name
        End If
        rs.MoveNext
    Wend
    rs.Close

    LinkTables = True
End Function


Sub CallLinkTables()
Dim Result As Boolean

'sample call:
Result = LinkTables("C:\Program Files\Microsoft Office\Office\Samples\Northwind.mdb")
Debug.Print Result
End Sub

Dim Result As Boolean
Result = LinkTables("C:\FCMTITS\FCMTITS-BACKEND.accdb")
Debug.Print Result

Public Function LinkBackEndExmpl(strFileName As String) As Boolean
On Error GoTo err_proc
'Function creates linked tables to all tables (except "msys*" tables) in BE database defined by strFilename

    Dim strSQL As String
    Dim dbs As DAO.Database
    Dim dbs1 As DAO.Database
    Dim dbs2 As DAO.Database
    Dim tdf As TableDef
    Dim tdf1 As TableDef
    Dim strTblName As String
        
    Set dbs2 = OpenDatabase(Application.CurrentProject.FullName)
    Set dbs1 = DBEngine.Workspaces(0).OpenDatabase(strFileName)
    
    Set dbs = db
    With dbs
        On Error Resume Next
        For Each tdf1 In dbs1.TableDefs
            strTblName = tdf1.Name
            If Left(strTblName, 4) <> "msys" Then
                dbs2.TableDefs.Delete strTblName
            End If
        Next tdf1
        On Error GoTo err_proc
        
        For Each tdf1 In dbs1.TableDefs
            strTblName = tdf1.Name
            If Left(strTblName, 4) <> "msys" And strTblName <> "tblCurStatus" Then
                Debug.Print strTblName
                Set tdf = .CreateTableDef(strTblName)
                tdf.Connect = ";DATABASE=" & strFileName
                tdf.SourceTableName = strTblName
                .TableDefs.Append tdf
            End If
        Next tdf1
    End With

    LinkBackEnd = True
    
exit_proc:
On Error Resume Next
    Set dbs = Nothing
    Set dbs2 = Nothing
    Set dbs1 = Nothing
    Exit Function
    
err_proc:
    MsgBox err.Description
    Debug.Print strFileName & Chr(13) & strTblName
    Resume exit_proc
    
End Function

Set dbs = db

Set dbs = CurrentDb

Public Function LinkBackEndExmpl(strFileName As String) As Boolean
On Error GoTo err_proc
'Function creates linked tables to all tables (except "msys*" tables) in BE database defined by strFilename

    Dim strSQL As String
    Dim dbs As DAO.Database
    Dim dbs1 As DAO.Database
    Dim dbs2 As DAO.Database
    Dim tdf As TableDef
    Dim tdf1 As TableDef
    Dim strTblName As String
        
    Set dbs2 = OpenDatabase(Application.CurrentProject.FullName)
    Set dbs1 = DBEngine.Workspaces(0).OpenDatabase(strFileName)
    
    Set dbs = db
    With dbs
        On Error Resume Next
        For Each tdf1 In dbs1.TableDefs
            strTblName = tdf1.Name
            If Left(strTblName, 4) <> "msys" Then
                dbs2.TableDefs.Delete strTblName
            End If
        Next tdf1
        On Error GoTo err_proc
        
        For Each tdf1 In dbs1.TableDefs
            strTblName = tdf1.Name
            Debug.Print strTblName
            If Left(strTblName, 4) <> "msys" Then
                Select Case strTblName
                Case "TableName1", "TableName2"   'List tables you do not want linked, separated by a comma

                Case Else
                    Set tdf = .CreateTableDef(strTblName)
                    tdf.Connect = ";DATABASE=" & strFileName
                    tdf.SourceTableName = strTblName
                    .TableDefs.Append tdf
                End Select
            End If
        Next tdf1
    End With

    LinkBackEnd = True
    
exit_proc:
On Error Resume Next
    Set dbs = Nothing
    Set dbs2 = Nothing
    Set dbs1 = Nothing
    Exit Function
    
err_proc:
    MsgBox err.Description
    Debug.Print strFileName & Chr(13) & strTblName
    Resume exit_proc
    
End Function