clsADOData




Option Explicit
Private Connected As Boolean
Private oCon As Connection
Private oCmd As Command
'________________________________________________________


Public Sub adoDisconnect()
Set oCmd = Nothing
Set oCon = Nothing
End Sub
'________________________________________________________


Public Function adoCreateRecordSet(lReturn As Long) As Variant
Dim RS As Recordset
Set RS = CreateObject("ADODB.RecordSet")
Set RS = oCmd.Execute
lReturn = CInt(oCmd.Parameters("RETURN_VALUE").Value)
If lReturn <> 0 Then Console.Important "Error create record set: {" & lReturn & "}", True
Set adoCreateRecordSet = RS
End Function
'________________________________________________________


Public Function adoAddParameters(ParamName As String, Value As Variant) As Boolean
On Error Goto adoAddParametersError

oCmd.Parameters("@" & ParamName).Value = Value

adoAddParameters = True

Exit Function

adoAddParametersError:
adoAddParameters = False
Exit Function

End Function
'________________________________________________________


Public Function adoSetStoredProcedure(ProcedureName As String) As Boolean

On Error Goto adoSetStoredProcedureError
With oCmd
.CommandText = ProcedureName
.CommandTimeout = 600
End With

oCmd.Parameters.Refresh

adoSetStoredProcedure = True

Exit Function

adoSetStoredProcedureError:
adoSetStoredProcedure = False
Exit Function

End Function
'________________________________________________________


Public Function adoConnect(ConnectionString As String, CommandType As Integer, CursorLocation As Integer, Provider As String) As Boolean

On Error Goto adoConnectError

Set oCon = CreateObject("ADODB.Connection")
Set oCmd = CreateObject("ADODB.Command")

With oCon
.Provider = Provider '"MSDASQL"
.CursorLocation = CursorLocation '3 - adUseClient

.ConnectionString = ConnectionString

.Open
End With

With oCmd
.ActiveConnection = oCon
.CommandType = CommandType '4 - adCmdStoredProc
End With

adoConnect = True

Exit Function

adoConnectError:
MsgBox "Connect To database failed with: " & Err.Number & " " & Err.Description
adoConnect = False
Exit Function

End Function
'________________________________________________________


Private Sub Class_Terminate()

If Connected Then adoDisconnect

End Sub

add referance "Microsoft ActiveX Data Objects 2.5 Library"
in project and declare the class.

I use it to connect to a SQL database it may require some
tweaking for other databases.










( clsadodata.html )- by Paolo Puglisi - Modifica del 17/12/2023