Else Portion of Code keeps timing out - vba

Question

I have a code to check the connection between access and sql server upon opening the form. If there is a connection a message box pops up and says so. If not there is supposed to be a message box indicating there is no connection. Instead I get the error:
Run Time Error '-2147467259 (80004005)':
[DBNETLIB][ConnectionOpen (Connect()).]Specified SQL Server Not Found
Which is not what I am wanting it to do, is it something in my coding or is there no way to get this to work?
Public Sub AutoExec()
Dim cnn As ADODB.Connection
Dim localrst As New ADODB.Recordset
Dim remoterst As New ADODB.Recordset
Set cnn = New ADODB.Connection
cnn.Open "Provider=SQLOLEDB; Data Source=DB; Initial Catalog=HRLearnDev;" _
& "User Id=ID; Password=PW;"
If cnn.State = adStateOpen Then
MsgBox ("You have an established connection with the L&TD SQL Server Database.")
Else
MsgBox ("Cannot connect to remote server. Data will be stored locally to CDData Table until application is opened again.")
End If
cnn.Close
End Sub

Answer 1

In situations like these, you typically want to use an On Error GoTo construct - then send the code to your error handler if an error occurs (you can test to make sure the error number is what you expect with Err.Num).
However, in your case it may be even easier to use On Error Resume Next. This tells the interpreter "If an error occurs, go to the next line. I will figure out what went wrong and deal with it."
You usually do this when you have a single function call that either produces an error or a sensible value. I often do something like this:
On Error Resume Next
returnValue = -1
returnValue = functionThatReturnsPositiveValue()
If returnValue < 0 Then
MsgBox "oops - the function failed!"
Else
' <<<< do whatever needs doing >>>>
End If
In your case that's almost exactly what you would do. Complete example:
Public Sub AutoExec()
Dim cnn As ADODB.Connection
Dim localrst As New ADODB.Recordset
Dim remoterst As New ADODB.Recordset
On Error Resume Next ' <<<<<< add this line so an error doesn't stop the code
Set cnn = New ADODB.Connection
cnn.State = 0 ' <<<<< not sure if you need something like this, or if the New command
already set it to some sensible value other than "adStateOpen"
cnn.Open "Provider=SQLOLEDB; Data Source=DB; Initial Catalog=HRLearnDev;" _
& "User Id=ID; Password=PW;"
If cnn.State = adStateOpen Then ' <<<<<< this will only be true if no error occurred
MsgBox ("You have an established connection with the L&TD SQL Server Database.")
Else
MsgBox ("Cannot connect to remote server. Data will be stored locally to CDData Table until application is opened again.")
End If
On Error GoTo 0 ' <<<<<<<< turn off error handling - we have passed the "tricky" spot.
' <<<<<< lots more code goes here >>>>>>
If cnn.State = adStateOpen Then cnn.Close ' <<<<<<<< only close connection if it was open!!
End Sub