Linking Your Access Databases with ADOX

Private Sub CreateLinkTables()
  On Error Resume Next

  Dim cnDB1    As New ADODB.Connection
  Dim cnDB2    As New ADODB.Connection
  Dim catDB1   As New ADOX.Catalog
  Dim catDB2   As New ADOX.Catalog
  Dim tblDB2   As New ADOX.Table
  Dim tblDB1   As ADOX.Table

  With cnDB1  ' Create connection to database 1
    .Provider = g_strDBProvider
    .Properties("Jet OLEDB:Database Password") = "myDBpassword"
    .Open "c:\myDB1.mdb"
  End With
  Set catDB1.ActiveConnection = cnDB1

  With cnDB2  ' Create connection to database 1
    .Provider = g_strDBProvider
    .Properties("Jet OLEDB:Database Password") = "myDBpassword"
    .Open "c:\myDB2.mdb"
  End With
  catDB2.ActiveConnection = cnDB2

  For Each tblDB2 In catDB2.Tables  ' Loop through myDB2 catalog tables
    If tblDB2.Type = "TABLE" Then ' Link only user created tables not view
and system table
      Set tblDB1 = New ADOX.Table ' Re-initialize object
      tblDB1.Name = tblDB2.Name
      Set tblDB1.ParentCatalog = catDB1
      tblDB1.Properties("Jet OLEDB:Create Link") = True
      tblDB1.Properties("Jet OLEDB:Link Datasource") = "c:\myDB2.mdb"
      tblDB1.Properties("Jet OLEDB:Link Provider String") = ";Pwd=" &
"myDBpassword"
      tblDB1.Properties("Jet OLEDB:Remote Table Name") = tblDB2.Name
      catDB1.Tables.Append tblDB1   ' Append tables to myDB1.mdb catalog
    End If
  Next

  ' Tidy up
  cnDB1.Close: Set cnDB1 = Nothing
  cnDB2.Close: Set cnDB2 = Nothing
  Set tblDB1 = Nothing: Set tblDB2 = Nothing
  Set catDB1 = Nothing: Set catDB2 = Nothing

End Sub