Sub LinkToDBase(strDirName As String, strTableName As String, _
strAccessTable)
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Set cat = New ADOX.Catalog
cat.ActiveConnection = CurrentProject.Connection
Set tbl = New ADOX.Table
tbl.Name = strAccessTable
Set tbl.ParentCatalog = cat
tbl.Properties("Jet OLEDB:Create Link") = True
tbl.Properties("Jet OLEDB:Link Datasource") = strDirName
tbl.Properties("Jet OLEDB:Link Provider String") = "dBASE III;HDR=NO;IMEX=2;"
tbl.Properties("Jet OLEDB:Remote Table Name") = strTableName
cat.Tables.Append tbl
End Sub