Роб,
Ниже приведен код, который сначала возвращает работающий DSN (пытаясь импортировать тестовую таблицу из каждого из двух перечисленных DSN), а затем просматривает все связанные таблицы в базе данных, чтобы при необходимости настройте DSN правильно:
Function fGetODBCName() As String
On Error GoTo E_Handle
DoCmd.DeleteObject acTable, "dbo_tblTest"
DoCmd.TransferDatabase acLink, "ODBC Database", "ODBC;DSN=REPORT;Trusted_Connection=Yes;DATABASE=TEST", acTable, "tblUser", "dbo_tblTest"
If Not IsNull(DLookup("Name", "MSysObjects", "Name='dbo_tblTest'")) Then
fGetODBCName = CurrentDb.TableDefs("dbo_tblTest").Connect
Else
DoCmd.TransferDatabase acLink, "ODBC Database", "ODBC;DSN=REPORTS;Trusted_Connection=Yes;DATABASE=TEST", acTable, "tblUser", "dbo_tblTest"
If Not IsNull(DLookup("Name", "MSysObjects", "Name='dbo_tblTest'")) Then
fGetODBCName = CurrentDb.TableDefs("dbo_tblTest").Connect
End If
End If
DoCmd.DeleteObject acTable, "dbo_tblTest"
fExit:
On Error Resume Next
Exit Function
E_Handle:
Select Case Err.Number
Case 3146 ' DSN does not exist
Resume Next
Case 7874 ' dbo_tblTest does not exist so cannot delete it
Resume Next
Case Else
MsgBox Err.Description & vbCrLf & vbCrLf & "fGetODBCName", vbOKOnly + vbCritical, "Error: " & Err.Number
End Select
Resume fExit
End Function
Sub sRelinkODBC()
On Error GoTo E_Handle
Dim db As DAO.Database
Dim lngLoop1 As Long
Dim lngCount As Long
Dim strConnect As String
Dim strLocal As String
Dim strSource As String
strConnect = fGetODBCName
If Len(strConnect) > 0 Then
Set db = DBEngine(0)(0)
db.TableDefs.Refresh
lngCount = db.TableDefs.Count - 1
For lngLoop1 = lngCount To 0 Step -1
If Len(db.TableDefs(lngLoop1).Connect) > 0 Then
If db.TableDefs(lngLoop1).Connect <> strConnect Then ' only relink if needed
strLocal = db.TableDefs(lngLoop1).Name
strSource = db.TableDefs(lngLoop1).SourceTableName
DoCmd.DeleteObject acTable, strLocal
DoCmd.TransferDatabase acLink, "ODBC Database", strConnect, acTable, strSource, strLocal
End If
End If
Next lngLoop1
db.TableDefs.Refresh
Else ' not able to find a suitable DSN
End If
sExit:
On Error Resume Next
Set db = Nothing
Exit Sub
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "sRelinkODBC", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit
End Sub
Хотя это работает, я настоятельно рекомендую вам поговорить с вами, поговорить с системными администраторами и заставить их развернуть один DSN для всех пользователей, использующих групповую политику.
HTH