Public Function NewLinkedExternalTableMdb() Dim strTargetDB() As String Dim strProviderString() As String Dim strSourceTbl() As String Dim strLinkTblName() As String Dim catDB As ADOX.Catalog Dim tblLink As ADOX.Table Dim tmpLink As ADOX.Table Dim i As Integer Dim j As Integer Set catDB = New ADOX.Catalog catDB.ActiveConnection = CurrentProject.Connection i = catDB.Tables.Count ReDim strTargetDB(i) ReDim strProviderString(i) ReDim strSourceTbl(i) ReDim strLinkTblName(i) i = 1 For Each tmpLink In catDB.Tables If tmpLink.Properties("Jet OLEDB:Create Link") Then If Trim(tmpLink.Properties("Jet OLEDB:Remote Table Name")) > "" Then strLinkTblName(i) = tmpLink.Name strTargetDB(i) = tmpLink.Properties("Jet OLEDB:Link Datasource") strProviderString(i) = tmpLink.Properties("Jet OLEDB:Link Provider String") strSourceTbl(i) = tmpLink.Properties("Jet OLEDB:Remote Table Name") Do While InStr(1, strTargetDB(i), "/") > 0 strTargetDB(i) = Mid(strTargetDB(i), InStr(1, strTargetDB(i), "/") + 1, Len(strTargetDB(i))) Loop strTargetDB(i) = CurrentProject.Path "/" strTargetDB(i) i = i + 1 End If End If
Next j = i - 1 For i = 1 To j catDB.Tables.Delete strLinkTblName(i) Set tblLink = New ADOX.Table With tblLink .Name = strLinkTblName(i) Set .ParentCatalog = catDB .Properties("Jet OLEDB:Create Link") = True .Properties("Jet OLEDB:Link Datasource") = strTargetDB(i) .Properties("Jet OLEDB:Link Provider String") = strProviderString(i) .Properties("Jet OLEDB:Remote Table Name") = strSourceTbl(i) End With catDB.Tables.Append tblLink Set tblLink = Nothing Next Set catDB = Nothing End Function