Question

I have actually this little function working as supposed:

Function createAttached(strTable As String, strPath As String, strBaseTable As String) As Boolean
    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
    myDB.TableDefs.Refresh

    fRetval = True

    DoCmd.SetWarnings True

CreateAttachedExit:
    createAttached = fRetval
    Exit Function

CreateAttachedError:
    If Err = 3110 Then
        Resume CreateAttachedExit
    Else
        If Err = 3011 Then
            Resume Next
        Else
            If Err = 3012 Then
                Set tdf = myDB.TableDefs(strTable)
                tdf.Connect = ";DATABASE=" & strPath
                tdf.RefreshLink
                fRetval = True
                GoTo CreateAttachedExit
            End If
        End If
    End If
End Function

This code works fine, I can call the function as many times as I want to add links to tables from another database. However, I have about 30 tables to import from the same database and this script restarts from scratch everytime I call it. Because the database is located on another server, it takes about 1 min to link the 30 tables.

Is there anything I could do with that function to make it work faster when I need to link multiple tables from the same database? I would like it to work with multiple strTable and strBaseTable in parameters instead of one (maybe arrays?), but I don’t know how to do this.

Thank you.

Answer 1

You can loop through the tabledefs collection in the external database or use a table of tables that lists all the tables to be connected and the external database.

Dim db As Database
Dim ThisDb As Database

Set ThisDb = CurrentDB
sDb = "z:\docs\test.accdb"
Set db = OpenDatabase(sDb)

For Each tdf In db.TableDefs
    ''Connect
    If Left(tdf.Name, 4) <> "MSys" Then
        If IsNull(DlookUp("Name","MsysObjects","Type In (1,4,5,6) And Name='" _
           & tdf.Name & "'")) Then
           DoCmd.TransferDatabase acLink, "Microsoft Access", _
             sDb, acTable, tdf.Name, tdf.Name
        Else
          If ThisDb.TableDefs(tdf.Name).connect <> vbNullString Then
             ThisDb.TableDefs(tdf.Name).connect = ";DATABASE=" & sDb
             ThisDb.TableDefs(tdf.Name).RefreshLink
          End If
        End If
    End If
Next

A table of tables would work in a similar fashion in that you can select the database (select distinct) from the table and loop through that recordset attaching the tables in a further selection (select table where database …)