How to determine if a SQL Server is available with VBA

kpurchase used Ask the Experts™
I am using MS Access and it connects to multiple SQL Servers. There is one that is occasionally down that most users do not need, so what I am trying to do is skip over this database if it is not available. However the following line of code is what I use to connect to the database:
        On Error GoTo WebServerConnectionError
        Set dbSQLServer = DBEngine.OpenDatabase("", dbDriverNoPrompt, False, gSQLServConnectionString)

However this does not throw a VBA code error it appears to throw an access error, in which the following box shows up in the access window.

Microsoft SQL Server Login
Connection failed:
SQLState: '08004'
SQL Server Error: 4060
Server rejected the connection; Access to selected database has been denied


Any ideas on how to handle this error programmatically?

Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Top Expert 2016

to get the error number, add this line on the error trapping

    Debug.Print Err.Number

i always get this error number everytime the connection to the server falis
    If Err.Number = -2147217843 Then


Hi Capricorn,
Thanks for the quick response. My main issue is that it doesnt appear to be throwing a VBA error, as it does not go to my 'WebServerConnectionError' section, but brings up the box I listed in the access window. Any ideas on how to make it throw a VBA error as opposed to bringing up the SQL Server connection box/window in Access? Thanks.
dwe761Software Engineer

There are a number of ways you could go using ADO, SQLDMO, or just trying to attach to a table on that database.  It's whatever you're most comfortable with and that gives the least overhead.  If using ADO or SQLDMO, you'll have to add a reference.  With attaching a table, there is some overhead in terms of performance to attach and detach a table just for the sake of a server test.

Here is an example using SQLDMO;

Below is an example of using ADO.

Hope this helps.
Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

dwe761Software Engineer

Sorry, forgot to include the ADO example.
Function IsSQLRunning(sCN$) As Boolean
On Error Resume Next
Dim Conn As ADODB.Connection
   Set Conn = New ADODB.Connection
   Conn.Open sCN
   If Err = 0 Then
      IsSQLRunning = True
   End If
   Set Conn = Nothing
End Function

Open in new window

Software Engineer
Here's another example by Microsoft around the same issue where they trap the error by trying to create and execute a querydef against the datasource.


Hi dwe,
Unforunately this application already has many references and it is really ideal to not have to add another one unless absolutely necessary. Any ideas on how it might be accomplished with DAO? I pretty much would like to do exactly what you are doing in your code example but with a DAO object, and its not something I have done before and not intuitive enough for me to figure out playing with the object on my own just yet.
Top Expert 2016
check the codes below..
configure your strODBC

pass an Arg  1 or 2 to the function


see if this will work for you
Function IsServerAvail(Arg) As Boolean
On Error GoTo ODBCErr
Dim strODBC As String, strMsg As String
strODBC = "ODBC;DSN=XXX_000;Description=XXXCompany;DATABASE=XXX_000;Trusted_Connection=Yes"
Dim Db As DAO.Database, Qry As QueryDef, RS As DAO.Recordset
Set Db = CurrentDb()
Set Qry = Db.CreateQueryDef("")
Qry.Connect = strODBC
' Set the SQL property and concatenate the variables.
Qry.sql = "sp_server_info " & Arg
    Qry.ReturnsRecords = True
    Set RS = Qry.OpenRecordset()
    IsServerAvail = Not RS.EOF
    'comment the following lines after testing
    strMsg = RS!attribute_id & "- " & RS!attribute_name & "- " & RS!attribute_value
    MsgBox strMsg
    Exit Function
    MsgBox Err.Number & " > " & Err.Description
    Resume ExitCheckODBC
End Function

Open in new window

dwe761Software Engineer

The one I sent in the Microsoft link will work for you without any new references (See Function Test_Login_Error in the Resolution section).  Capricorn1's solution will work as well because they're both creating a pass-through query against the server and testing for a positive outcome.  The difference (probably negligible) is that the Microsoft approach may be a little faster in that no records are returned and no recordset must be created and closed.

Take your pick.  They'll both do the job.


Thanks guys, forgot about this question, both of your solutions did work for me.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial