访问VBA连接以测试SQL Server的存在

时间:2016-05-25 00:48:30

标签: sql-server access-vba

我有一个Access应用程序,需要连接到几个可能的SQL Server之一(即连接链接表),我有一个可能的SQL Server实例名称列表。当应用程序启动时,需要查看哪些可能的服务器可用。考虑到使用SQLBrowseConnect或NetServerEnum等解决方案的缓慢,我想知道是否有一种干净,快速的方法来根据其名称“ping”SQL Server。

1 个答案:

答案 0 :(得分:2)

我们使用传递查询VerifyConnection,它只打开一个小表。

测试改变连接并检查它是否可以读取表格:

Public Function IsSqlServer( _
    ByVal TestNewConnection As Boolean, _
    Optional ByVal Hostname As String, _
    Optional ByVal Database As String, _
    Optional ByVal Username As String, _
    Optional ByVal Password As String, _
    Optional ByRef ErrNumber As Long) _
    As Boolean

    Const cstrQuery     As String = "VerifyConnection"

    Dim dbs             As DAO.Database
    Dim qdp             As DAO.QueryDef
    Dim rst             As DAO.Recordset

    Dim booConnected    As Boolean
    Dim strConnect      As String
    Dim strConnectOld   As String
    Dim booCheck        As Boolean

    Set dbs = CurrentDb
    Set qdp = dbs.QueryDefs(cstrQuery)

    If Hostname & Database & Username & Password = "" Then
        If TestNewConnection = False Then
            ' Verify current connection.
            booCheck = True
        Else
            ' Fail. No check needed.
            ' A new connection cannot be checked with empty parameters.
        End If
    Else
        strConnectOld = qdp.Connect
        strConnect = ConnectionString(Hostname, Database, Username, Password)
        If strConnect <> strConnectOld Then
            If TestNewConnection = False Then
                ' Fail. No check needed.
                ' Tables are currently connected to another database.
            Else
                ' Check a new connection.
                qdp.Connect = strConnect
                booCheck = True
            End If
        Else
            ' Check the current connection.
            strConnectOld = ""
            booCheck = True
        End If
    End If

    On Error GoTo Err_IsSqlServer

    ' Perform check of a new connection or verify the current connection.
    If booCheck = True Then
        Set rst = qdp.OpenRecordset()
        ' Tried to connect ...
        If ErrNumber = 0 Then
            If Not (rst.EOF Or rst.BOF) Then
                ' Success.
                booConnected = True
            End If
            rst.Close
        End If

        If strConnectOld <> "" Then
            ' Restore old connection parameters.
            qdp.Connect = strConnectOld
        End If
    End If

    Set rst = Nothing
    Set qdp = Nothing
    Set dbs = Nothing

    IsSqlServer = booConnected

Exit_IsSqlServer:
    Exit Function

Err_IsSqlServer:
    ' Return error.
    ErrNumber = Err.Number
    ErrorMox "Tilslutning af database"
    ' Resume to be able to restore qdp.Connect to strConnectOld.
    Resume Next

End Function

通过这种方式,您可以检查完整路线到单个表格。