Access VBA connection to test existence of SQL Server - sql-server

Question

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.

Answer 1

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.