Verify Connection

[yawnzzzz]

Hi,

I have some VBA code that connects to a SQL Database that's on an internal network. This code does other things where they don't need access to the Database. So, when an individual is at home, I'd like to be able to detect in the quickest way possible whether they can reach the Database or not.

Right now, my code catches the error when it tries to open the connection. When it can't find the DB, it returns the error:
[DBNETLIB][ConnectionOpen (Connect()).]SQL Server does not exist or access is denied

If they're on the network or have a VPN connection, it normally takes under a second to connect, but this error takes 11 seconds, so I'd like to find a way to make it error out sooner.

Public Sub ExampleDBCall()
    On Error GoTo errHandler
    Dim cnPubs As Object
    Dim cnCmd As Object
    Set cnPubs = CreateObject("ADODB.Connection")
    Set cnCmd = CreateObject("ADODB.Command")
    cnPubs.Open strConn '<---Connection String to Database
    cnCmd.ActiveConnection = cnPubs
        
    With cnCmd
            .CommandText = "storeuser_rw.StoredProcedureName"
            .CommandType = 4 'adCmdStoredProc
            .Parameters.Refresh
            .Parameters("@Field") = value
            .Execute
    End With
    cnPubs.Close
    Set cnPubs = Nothing
    Set cnCmd = Nothing
    Exit Sub
errHandler:
    If cnPubs Is Nothing Then
    Else
        If cnPubs.State = 1 Then
            cnPubs.Close
        End If
        Set cnPubs = Nothing
    End If
    Set cnCmd = Nothing
    MsgBox "An error occured." & vbCr & Err.Description
End Sub