CODEWITHSUNDEEP
sql-serverms-accessvba
bcrimmins
bcrimmins

Reputation: 135

Access VBA connection to test existence of SQL Server

I have an Access application that needs to connect to one of several possible SQL Servers (i.e., connect linked tables) and I have a list of those possible SQL Server instance names. When the application launches, it needs to go see which of the possible servers is available. Considering the sluggishness of solutions like using SQLBrowseConnect or NetServerEnum, I'm wondering if there is a clean and fast way to 'ping' for a SQL Server based on its name.

Upvotes: 2

Views: 1840

Answers (1)

Gustav
Gustav

Reputation: 56026

We use a pass-through query, VerifyConnection, which just opens a small table.

The test alters the connection and checks if it can read the table:

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

This way you will check the complete route all the way to a single table.

Upvotes: 2

Related Questions