Auto link tables using access

I have two databases, one with data and one with the program

I need to link the data-database to the program database
I can do it manually but thats not what I want

I need a function to link them automatically

This is the function so far, but somehow the tables don't get into the database

Public Function PubFuncLinkTablesWerk()
    Dim mydb As DATABASE, linkdb As DATABASE
    Dim answ As String
    Dim xTableDef As TableDef
    Dim i As Integer, j As Integer
   
    answ = InputBox("Geef de fullpath name en databasename op. ", "Link Tables Werk", "c:\Calculator Werk\Calculator\Program\CalculatorProg.mdb")
    If answ <> "" Then
        On Error GoTo errorhandler
        Set mydb = OpenDatabase(answ)
        On Error GoTo 0
        For i = 1 To 5
            On Error GoTo errorhandler
            Select Case i
                Case 1
                    Set linkdb = OpenDatabase("c:\Calculator Werk\calculator\file\dbcalculatorinternedocumenten.mdb", False, False, ";pwd=test")
                Case 2
                    Set linkdb = OpenDatabase("c:\Calculator Werk\calculator\file\dbcalculatorparameters.mdb", False, False, ";pwd=test")
                Case 3
                    Set linkdb = OpenDatabase("c:\Calculator Werk\calculator\file\dbcalculatorvelleninput.mdb", False, False, ";pwd=test")
                Case 4
                    Set linkdb = OpenDatabase("c:\Calculator Werk\calculator\file\dbcalculatorvellenberekeningen.mdb", False, False, ";pwd=test")
                Case 5
                    Set linkdb = OpenDatabase("c:\Calculator Werk\calculator\file\dbklanten.mdb", False, False, ";pwd=test")
            End Select
            On Error GoTo 0
            On Error GoTo eindetabel
            For j = 1 To linkdb.TableDefs.Count - 1
                If UCase(Left(linkdb.TableDefs(j).Name, 4)) <> "MSYS" Then
                    Set xTableDef = mydb.CreateTableDef(linkdb.TableDefs(j), dbAttachedTable, linkdb.TableDefs(j).Name)
                End If
            Next j
eindetabel:
            On Error GoTo 0
        Next i
        mydb.Close
        linkdb.Close
        Set mydb = Nothing
        Set linkdb = Nothing
    End If
Exit Function
errorhandler:
    MsgBox "Error : " & Err & ":" & Error, vbExclamation, "Link Tables Werk"
    Exit Function
End Function


Can anybody help me, it has to be a stupid thing i'm forgetting

Frederik
Start Free Trial