LISTING 2: Updated Recordset.bas Code

Option Explicit
Dim rs As ADODB.Recordset
Dim cmd As ADODB.Command
Dim con As ADODB.Connection

Function RunSQLWithRS(ByVal strSQL As String _
    ) As ADODB.Recordset
    
    On Error GoTo errorHandler
    
    Dim rs As ADODB.Recordset, cmd As ADODB.Command
    Dim testrs As Object
    
    Set rs = ContextCreateObject("ADODB.Recordset")
    Set cmd = ContextCreateObject("ADODB.Command")
       
    cmd.ActiveConnection = GetDSN()
    cmd.CommandText = strSQL
    cmd.CommandType = adCmdText
    
    rs.CursorLocation = adUseClient
    rs.Open cmd, , adOpenForwardOnly, adLockReadOnly
    
    Set cmd.ActiveConnection = Nothing
    Set cmd = Nothing
    Set rs.ActiveConnection = Nothing

    Set RunSQLWithRS = rs
    
    ContextSetComplete
    Exit Function
    
errorHandler:
    Err.Raise Err.Number, "RunSQLWithRS", Err.Description
End Function

Function RunSQL(ByVal strSQL As String) As Variant
    
    On Error GoTo errorHandler
    
    Dim cmd As ADODB.Command
    Set cmd = ContextCreateObject("ADODB.Command")
    
    cmd.ActiveConnection = GetDSN()
    cmd.CommandText = strSQL
    cmd.CommandType = adCmdText
    
    cmd.Execute , , ADODB.adExecuteNoRecords
    
    Set cmd.ActiveConnection = Nothing
    Set cmd = Nothing
    
    Exit Function
    
errorHandler:
    Err.Raise Err.Number, "RunSQLWithRS", Err.Description
End Function

Function GetConnection() As ADODB.Connection
    Dim con As ADODB.Connection
    Set con = ContextCreateObject("ADODB.Connection")
       
    con.Open GetDSN()
    
    Set GetConnection = con
    
End Function