I use the following from within some excel procedures to establish a connection to our database.
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 rs
is 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?
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
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 = Nothing
End If
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 = 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
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 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
来源:https://stackoverflow.com/questions/17611545/check-if-adodb-connection-is-open