如果主ODBC DSN不存在，则使用备用ODBC DSN

Question

我有多个用户通过使用两个ODBC系统DSNs中的一个连接到Server : REPORT和REPORTS。除了名字以外，它们是相同的。我定期更新或创建新的基于访问的工具，然后将这些工具部署到共享网络驱动器中。目前，我必须维护每个工具的两个版本--一个使用报告，另一个使用报告。我正在寻找一种方法来测试和重新连接这些表：

如果存在报表，则使用

• 和重新链接表。如果存在报告，则使用
• 。如果存在，请使用该报表和重新链接表。
• 返回错误消息。

。

我有在VBA中使用无DSN连接的经验，如果没有一种方法来测试已经存在的ODBC连接，这可能是一个可行的选择。理想情况下，我会让IT对DSN名称进行标准化，但是历史太深了，我无法很容易地确定谁使用了哪个DSN。

Answer 1

罗伯，

下面是一些代码，这些代码首先返回工作的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