Figure 3   Database Class


 VERSION 1.0 CLASS
 BEGIN
   MultiUse = -1  'True
   Persistable = 0  'NotPersistable
   DataBindingBehavior = 0  'vbNone
   DataSourceBehavior  = 0  'vbNone
   MTSTransactionMode  = 0  'NotAnMTSObject
 END
 Attribute VB_Name = "Database"
 Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = True
 Attribute VB_PredeclaredId = False
 Attribute VB_Exposed = True
 Option Explicit
 Const g_clsName = "Database"
 Dim modDSN As String
 Property Let dsn(dsn As String)
     
     modDSN = dsn
         
 End Property
 
 Function RunWithRS(ByVal strSP As String, strDSN As String) As Variant
     On Error GoTo errorHandler
     
     If strDSN = "" Then
         If modDSN = "" Then
             RunWithRS = -99
         Else
             strDSN = modDSN
         End If
     End If
     ' Set up Command and Connection objects
     Dim rs As ADODB.Recordset, cmd As ADODB.Command
     Set rs = CreateObject("ADODB.Recordset")
     Set cmd = CreateObject("ADODB.Command")
        
     'Run the procedure
     cmd.ActiveConnection = strDSN
     cmd.CommandText = strSP
     cmd.CommandType = adCmdText
     
     rs.CursorLocation = adUseClient
     rs.Open cmd, , adOpenForwardOnly, adLockReadOnly
     Set cmd.ActiveConnection = Nothing
     Set cmd = Nothing
     Set rs.ActiveConnection = Nothing
 
     Set RunWithRS = rs
     Exit Function
     
 errorHandler:
     Set RunWithRS = Nothing
     RunWithRS = "Error RunWithRS: " & _
     Err.Number & " Description :" & Err.Description
 End Function
 
 Function RunWithRS_RW(ByVal strSP As String, Optional strDSN As String) As Variant
     On Error GoTo errorHandler
     
    If strDSN = "" Then
         If modDSN = "" Then
             RunWithRS_RW = -99
         Else
             strDSN = modDSN
         End If
     End If
   
     ' Set up Command and Connection objects
     Dim rs As ADODB.Recordset, cmd As ADODB.Command
     Set rs = CreateObject("ADODB.Recordset")
     Set cmd = CreateObject("ADODB.Command")
        
     'Run the procedure
     cmd.ActiveConnection = strDSN
     cmd.CommandText = strSP
     cmd.CommandType = adCmdText
     
     rs.CursorLocation = adUseClient
     rs.Open cmd, , adOpenDynamic, adLockBatchOptimistic
     Set cmd = Nothing
     
     Set RunWithRS_RW = rs
     Exit Function
     
 errorHandler:
     Set RunWithRS_RW = Nothing
     RunWithRS_RW = "Error RunWithRS_RW: " & _
     Err.Number & " Description :" & Err.Description
 End Function
 
 Function ConvertToString(v As Variant) As String
     If IsNull(v) Then
         ConvertToString = ""
     Else
         ConvertToString = CStr(v)
     End If
 End Function