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