Check if ADODB connection is open

ADO Recordset has .State property, you can check if its value is adStateClosed or adStateOpen

If Not (rs Is Nothing) Then  If (rs.State And adStateOpen) = adStateOpen Then rs.Close  Set rs = NothingEnd If

MSDN about State property

Edit;The reason not to check .State against 1 or 0 is because even if it works 99.99% of the time, it is still possible to have other flags set which will cause the If statement fail the adStateOpen check.

Edit2:

For Late binding without the ActiveX Data Objects referenced, you have few options.Use the value of adStateOpen constant from ObjectStateEnum

If Not (rs Is Nothing) Then  If (rs.State And 1) = 1 Then rs.Close  Set rs = NothingEnd If

Or you can define the constant yourself to make your code more readable (defining them all for a good example.)

Const adStateClosed As Long = 0 'Indicates that the object is closed.Const adStateOpen As Long = 1 'Indicates that the object is open.Const adStateConnecting As Long = 2 'Indicates that the object is connecting.Const adStateExecuting As Long = 4 'Indicates that the object is executing a command.Const adStateFetching As Long = 8 'Indicates that the rows of the object are being retrieved.    [...]If Not (rs Is Nothing) Then    ' ex. If (0001 And 0001) = 0001 (only open flag) -> true    ' ex. If (1001 And 0001) = 0001 (open and retrieve) -> true    '    This second example means it is open, but its value is not 1    '    and If rs.State = 1 -> false, even though it is open    If (rs.State And adStateOpen) = adStateOpen Then         rs.Close    End If    Set rs = NothingEnd If

This topic is old but if other people like me search a solution, this is a solution that I have found:

Public Function DBStats() As Boolean    On Error GoTo errorHandler        If Not IsNull(myBase.Version) Then             DBStats = True        End If        Exit Function    errorHandler:        DBStats = False  End Function

So "myBase" is a Database Object, I have made a class to access to database (class with insert, update etc...) and on the module the class is use declare in an object (obviously) and I can test the connection with "[the Object].DBStats":

Dim BaseAccess As New myClassBaseAccess.DBOpen 'I open connectionDebug.Print BaseAccess.DBStats ' I test and that tell me trueBaseAccess.DBClose ' I close the connectionDebug.Print BaseAccess.DBStats ' I test and tell me false

Edit : In DBOpen I use "OpenDatabase" and in DBClose I use ".Close" and "set myBase = nothing"Edit 2: In the function, if you are not connect, .version give you an error so if aren't connect, the errorHandler give you false

This is an old topic, but in case anyone else is still looking...

I was having trouble after an undock event. An open db connection saved in a global object would error, even after reconnecting to the network. This was due to the TCP connection being forcibly terminated by remote host. (Error -2147467259: TCP Provider: An existing connection was forcibly closed by the remote host.)

However, the error would only show up after the first transaction was attempted. Up to that point, neither Connection.State nor Connection.Version (per solutions above) would reveal any error.

So I wrote the small sub below to force the error - hope it's useful.

Performance testing on my setup (Access 2016, SQL Svr 2008R2) was approx 0.5ms per call.

Function adoIsConnected(adoCn As ADODB.Connection) As Boolean    '----------------------------------------------------------------    '#PURPOSE: Checks whether the supplied db connection is alive and    '          hasn't had it's TCP connection forcibly closed by remote    '          host, for example, as happens during an undock event    '#RETURNS: True if the supplied db is connected and error-free,     '          False otherwise    '#AUTHOR:  Belladonna    '----------------------------------------------------------------    Dim i As Long    Dim cmd As New ADODB.Command    'Set up SQL command to return 1    cmd.CommandText = "SELECT 1"    cmd.ActiveConnection = adoCn    'Run a simple query, to test the connection    On Error Resume Next    i = cmd.Execute.Fields(0)    On Error GoTo 0    'Tidy up    Set cmd = Nothing    'If i is 1, connection is open    If i = 1 Then        adoIsConnected = True    Else        adoIsConnected = False    End IfEnd Function