Sub ChangeLinkODBC()
Dim sDBFullPathName As String
Dim catDB As ADOX.Catalog
Dim conDB As ADODB.Connection
Dim tblLink As ADOX.Table
Dim tblLink0 As ADOX.Table, tblLink1 As ADOX.Table
Dim sTableName As String, sPref As String
Dim sLinkToName0 As String, sLinkToName1 As String
Dim sLinkProvider0 As String, sLinkProvider1 As String
sPref = "tmp_"
sTableName = "AccessTableName" ' name in access
sLinkToName1 = "LinkedName" ' external name of linked table, same as in "Jet OLEDB:Remote Table Name"
sDBFullPathName = "D:\test\test.mdb"
Set catDB = New ADOX.Catalog
Set conDB = New ADODB.Connection
conDB.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sDBFullPathName
catDB.ActiveConnection = conDB
catDB.Tables.Refresh
For Each tblLink In catDB.Tables
' test Type, for linked access is "LINK", linked ODBC is "PASS-THROUGH
If tblLink.Type = "PASS-THROUGH" And tblLink.Name = sTableName Then
Set tblLink0 = tblLink
' pick source table
sLinkToName0 = tblLink0.Properties("Jet OLEDB:Remote Table Name")
sLinkProvider0 = tblLink0.Properties("Jet OLEDB:Link Provider String")
' rename
tblLink0.Name = sPref & sTableName
' ...add new with previous name...
Set tblLink1 = New ADOX.Table
' change link provider string if necessary
sLinkProvider1 = sLinkProvider0
With tblLink1
.Name = sTableName
Set .ParentCatalog = catDB
.Properties("Jet OLEDB:Create Link") = True
.Properties("Jet OLEDB:Link Provider String") = "ODBC;" & sLinkProvider1
.Properties("Jet OLEDB:Remote Table Name") = sLinkToName1
End With
catDB.Tables.Append tblLink1
' ...and delete old.
catDB.Tables.Delete sPref & sTableName
Exit For
End If
Next tblLink
End Sub