This is a data access layer to restrict the types of calls available and also to give tracing of calls.
This version interfaces with the user via adodb objects but this could be replaced by generic objects.
It enforces disconnected recorsets


globals
    Public gTrace As Integer
    Public gLogFile As String

Make this a global for client server
    Dim objDB As clsDBAccess


example call 
    Dim objRs As ADODB.Recordset
    Dim objCmd As ADODB.Command
    Dim objParams As New clsDBParameters
    
    Set objDB = New clsDBAccess
    objDB.Connect
    objParams.AddParameter gProject_id, "integer"
    Set objCmd = New ADODB.Command
    Set objRs = objDB.OpenResultSet("s_GetIssues", objParams)



class clsDBAccess

Option Explicit
Private DBcon As New ADODB.Connection

Function Connect() As Boolean


Dim sServer As String
Dim sUser As String
Dim sPWD As String
Dim sDatabase As String
Dim i As Integer
Dim iFile As Integer
    
    ' this would normally come from the registry or an ini file
    sServer = "(local)"
    sDatabase = "mydatabase"
    sUser = "sa"
    sPWD = "password"

    DBcon.ConnectionString = "Provider=sqloledb;" & _
        "server=" & sServer & ";uid=" & sUser & ";pwd=" & sPWD & ";database=" & sDatabase
    DBcon.CursorLocation = adUseClient
    If gTrace = True Then
        iFile = FreeFile
        Open gLogFile For Append As iFile
        Print #iFile, "connecting to database " & sServer & "\" & sDatabase
        Close iFile
    End If
    'MsgBox "connecting to database " & sServer & "\" & sDatabase
    DBcon.Open
    If gTrace = True Then
        iFile = FreeFile
        Open gLogFile For Append As iFile
        Print #iFile, "connected"
        Close iFile
    End If
End Function

Public Function OpenResultSet(sProcName As String, Optional vParam As Variant) As ADODB.Recordset

Dim objRs As New ADODB.Recordset
Dim objCmd As New ADODB.Command

Dim iFile As Integer
Dim dStartTime As Date
Dim dEndTime As Date
Dim iStartTime As Single
Dim iEndTime As Single
Dim sLog As String

    objCmd.ActiveConnection = DBcon
    objCmd.CommandType = adCmdStoredProc
    objCmd.CommandText = sProcName
    
    If Not IsMissing(vParam) Then
        AddParams objCmd, vParam, sLog
    End If
    
    If gTrace = True Then
        iFile = FreeFile
        Open gLogFile For Append As iFile
        Print #iFile, "DB Access - start = " & Now & " proc = " & sProcName & " " & sLog; ""
        Close iFile
        dStartTime = Now
        iStartTime = Timer
    End If
    
    Set objRs = objCmd.Execute
    
    If gTrace = True Then
        dEndTime = Now
        iEndTime = Timer
    End If
    
    Set objRs.ActiveConnection = Nothing
    Set OpenResultSet = objRs
    Set objRs = Nothing
    Set objCmd = Nothing
        
    If gTrace = True Then
        iFile = FreeFile
        Open gLogFile For Append As iFile
        Print #iFile, "DB Access - start = " & dStartTime & " end = " & dEndTime & " time = " & Format(iEndTime - iStartTime, "##0.000000") & " secs, proc = " & sProcName
        Close iFile
    End If

End Function

Public Sub ExecCmd(sProcName As String, Optional vParam As Variant)

Dim objCmd As New ADODB.Command
    
Dim iFile As Integer
Dim dStartTime As Date
Dim dEndTime As Date
Dim iStartTime As Single
Dim iEndTime As Single
Dim sLog As String
    
    objCmd.ActiveConnection = DBcon
    objCmd.CommandType = adCmdStoredProc
    objCmd.CommandText = sProcName
    
    If Not IsMissing(vParam) Then
        AddParams objCmd, vParam, sLog
    End If
    
    If gTrace = True Then
        iFile = FreeFile
        Open gLogFile For Append As iFile
        Print #iFile, "DB Access - start = " & Now & " proc = " & sProcName & " " & sLog; ""
        Close iFile
        dStartTime = Now
        iStartTime = Timer
    End If
    
    objCmd.Execute
    Set objCmd = Nothing
    
    If gTrace = True Then
        dEndTime = Now
        iEndTime = Timer
    End If
    
    If gTrace = True Then
        iFile = FreeFile
        Open gLogFile For Append As iFile
        Print #iFile, "DB Access - start = " & dStartTime & " end = " & dEndTime & " time = " & Format(iEndTime - iStartTime, "##0.000000") & " secs, proc = " & sProcName
        Close iFile
    End If

End Sub

Private Sub AddParams(objCmd As ADODB.Command, vParam As Variant, sLog As String)
Dim objParams As clsDBParameters
Dim prm As ADODB.Parameter

    Set objParams = vParam
    For Each prm In objParams.colParameters
        objCmd.Parameters.Append prm

        sLog = sLog & IIf(sLog <> "", ",", "")
        If prm.Type = adVarChar Then
            sLog = sLog & "'" & prm.Value & "'"
        ElseIf prm.Type = adDBTimeStamp Then
            sLog = sLog & "'" & Format(prm.Value, "yyyymmdd hh:nn:ss") & "'"
        Else
            sLog = sLog & prm.Value
        End If
    
    Next

End Sub

Public Sub BeginTran()

Dim objCmd As New ADODB.Command
    objCmd.ActiveConnection = DBcon
    objCmd.CommandText = "Begin tran"
    objCmd.CommandType = adCmdText
    objCmd.Execute
    Set objCmd = Nothing

End Sub

Public Sub CommitTran()

Dim objCmd As New ADODB.Command
    objCmd.ActiveConnection = DBcon
    objCmd.CommandText = "Commit tran"
    objCmd.CommandType = adCmdText
    objCmd.Execute
    Set objCmd = Nothing

End Sub


class clsDBParameters

Option Explicit
Public colParameters As New Collection
Public sLog As String

Public Function AddParameter(vValue As Variant, sType As String)

Dim prm As New ADODB.Parameter
    
    prm.Direction = adParamInput
    Select Case LCase(sType)
        Case "string"
            prm.Type = adVarChar
            If IsNull(vValue) Or Len(vValue) = 0 Then
                prm.Size = 1
            Else
                prm.Size = Len(vValue)
            End If
        Case "integer"
            prm.Type = adInteger
        Case "date"
            prm.Type = adDBTimeStamp
        Case "money"
            prm.Type = adCurrency
        Case Else
            Err.Raise vbObjectError + 1000, "Invalid type"
    End Select
    prm.Value = vValue
    colParameters.Add prm
    
End Function