vba 检查 ADODB 连接是否打开

Check if ADODB connection is open

提问by whytheq

I use the following from within some excel procedures to establish a connection to our database.

我在一些 excel 程序中使用以下内容来建立到我们的数据库的连接。

Private Const strConn As String = _
    "PROVIDER=SQLOLEDB.1 ..."     

Sub OpenConnection()

Set cn = CreateObject("ADODB.Connection")
cn.Open strConn
cn.CommandTimeout = 0
Set rs = CreateObject("ADODB.Recordset")
Set rs.ActiveConnection = cn

End Sub 

In subsequent code I open the connection using various SQL strings.
I'd like to test if rsis open so I know that it needs to be closed but the following does not work. How can I change the condition in the following to work?

在随后的代码中，我使用各种 SQL 字符串打开连接。
我想测试是否rs打开，所以我知道它需要关闭，但以下不起作用。如何更改以下条件才能工作？

If (rs.Open = True) Then
    rs.Close
End If

The following works but I'd rather not use error trapping in this way:

以下工作，但我宁愿不以这种方式使用错误捕获：

On Error Resume Next
    rs.Close

回答by Raybarg

ADO Recordset has .Stateproperty, you can check if its value is adStateClosedor adStateOpen

ADO Recordset 有.State属性，你可以检查它的值是adStateClosed还是adStateOpen

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

MSDN about State property

MSDN 关于 State 属性

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

编辑; 不检查.State1 或 0 的原因是因为即使它在 99.99% 的时间内都有效，仍有可能设置其他标志，这将导致 If 语句无法通过adStateOpen检查。

Edit2:

编辑2：

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

对于没有引用 ActiveX 数据对象的后期绑定，您几乎没有选择。使用ObjectStateEnum中 adStateOpen 常量的值

If Not (rs Is Nothing) Then
  If (rs.State And 1) = 1 Then rs.Close
  Set rs = Nothing
End 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 = Nothing
End If

回答by JustGuest

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":

所以“myBase”是一个数据库对象，我创建了一个类来访问数据库（带有插入、更新等的类），并且在模块上，该类在对象中使用声明（显然），我可以测试连接使用“[对象].DBStats”：

Dim BaseAccess As New myClass
BaseAccess.DBOpen 'I open connection
Debug.Print BaseAccess.DBStats ' I test and that tell me true
BaseAccess.DBClose ' I close the connection
Debug.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

编辑：在 DBOpen 中我使用“OpenDatabase”，在 DBClose 中我使用“.Close”和“set myBase = nothing”编辑 2：在函数中，如果你没有连接，.version 会给你一个错误，所以如果没有连接, errorHandler 给你假

回答by Belladonna

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.)

我在取消停靠事件后遇到了麻烦。即使在重新连接到网络后，保存在全局对象中的打开的数据库连接也会出错。这是由于远程主机强行终止了 TCP 连接。（错误 -2147467259：TCP 提供程序：远程主机强行关闭了现有连接。）

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

但是，错误只会在尝试第一次交易后出现。到目前为止，Connection.State 和 Connection.Version（根据上述解决方案）都不会显示任何错误。

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.

我的设置（Access 2016，SQL Svr 2008R2）的性能测试是每次调用大约 0.5 毫秒。

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 If

End Function