' *********************************************************************************************
' Database Connection Helper
'
' Description:      Executes an SQL stored procedure within the specified database,
'                   using parameters passed by the user. It also execute SQL line statement
'                   with or without parameter. See HOW TO USE below.
'
' Author:           Jessie P. Semana
' Create Date:      March 3, 2014
' Current Version:  1.0.3
'
' ---------------------------------------------------------------------------------------------
' CHANGE LOG:
' ---------------------------------------------------------------------------------------------
' #1 March 3, 2014      - Initial Version
' #2 May 28, 2014       - Add additional method "ExecuteQuery(query as String)"
' #3 May 29, 2014       - Fix bug where cmd object doesn't initialize new instance when calling the methods.
'                       - Fix bug where m_sqlParams property doesn't reset.
'                       - Raise an error message instead of warning message when no connection string pass in the class.
'                       - Add class initialization by calling "Class_Initialize".
'                       - Add the ability to rollback transaction when error raise in the middle of your transaction.
'
' ---------------------------------------------------------------------------------------------
' HOW TO USE:
' ---------------------------------------------------------------------------------------------
'
' Dim conn As New DBConnection
' Dim sqlCmd As ADODB.Command
' Dim rs As New ADODB.Recordset
'
' ---------------------------------------------------------------------------------------------
' Using Stored Procedure:
' ---------------------------------------------------------------------------------------------
'
' conn.ConnectionString = "YourConnectionString"
'
' Set sqlCmd = New ADODB.Command
' With sqlCmd
'     .Parameters.Append .CreateParameter("@Mode", adInteger, adParamInput, 50, 0)
'     .Parameters.Append .CreateParameter("@EmployeeID", adVarChar, adParamInput, 50, "YourValue")
'
'     conn.StoredProcedure = "spEmployee"
'     conn.SQLParameters = sqlCmd.Parameters
'     Set rs = conn.ExecuteCommand()
' End With
'
' ---------------------------------------------------------------------------------------------
' Using SQL Line Statement WITHOUT parameter:
' ---------------------------------------------------------------------------------------------
'
' Set rs = conn.ExecuteQuery("SELECT * FROM Employee;")
'
' ---------------------------------------------------------------------------------------------
' Using SQL Line Statement WITH parameter:
' ---------------------------------------------------------------------------------------------
'
' conn.ConnectionString = "YourConnectionString"
'
' With sqlCmd
'     .Parameters.Append .CreateParameter("@EmployeeID", adVarChar, adParamInput, 50, "YourValue")
'     conn.SQLParameters = sqlCmd.Parameters
'     Set rs = conn.ExecuteQuery("SELECT * FROM Employee WHERE EmployeeID = ?")
' End With
' *********************************************************************************************

Dim conn As ADODB.Connection
Dim cmd As ADODB.Command
Dim rs As New ADODB.Recordset

Private m_storedProc As String
Private m_sqlParams As ADODB.Parameters
Private m_connString As String

Public Property Get StoredProcedure() As String
    StoredProcedure = m_storedProc
End Property

Public Property Let StoredProcedure(ByVal pStoredProcedure As String)
    m_storedProc = pStoredProcedure
End Property

'Public Property Get SqlParameters() As ADODB.Parameters
'    SqlParameters = m_sqlParams
'End Property
Public Property Let SqlParameters(ByVal pSQLParameters As ADODB.Parameters)
    Set m_sqlParams = pSQLParameters
End Property

Public Property Get ConnectionString() As String
    ConnectionString = m_connString
End Property

Public Property Let ConnectionString(ByVal pConnectionString As String)
    m_connString = pConnectionString
End Property

Private Sub Class_Initialize()

    ' This will trigger every time you initialize new DBConnection class.

    m_connString = ""
    m_storedProc = ""

    Set conn = Nothing
    Set cmd = Nothing
    Set rs = Nothing
    Set m_sqlParams = Nothing

End Sub

Public Function ExecuteNonCommand(Optional query As String) As Integer
On Error GoTo TransError

    Dim param As New ADODB.Parameter
    Dim rowAffected As Long

    ' Clear any error first
    Err.Clear

    If m_connString = "" Then
        Err.Raise 22001, "DBConnection class", "No valid connection string. Make sure you supply connection string property in DBConnection class."
    End If

    Set conn = New ADODB.Connection
    With conn
        .ConnectionString = m_connString
        .ConnectionTimeout = 120
        .CommandTimeout = 120
        .Open
    End With

    Set cmd = New ADODB.Command
    With cmd
        .ActiveConnection = conn

        If m_storedProc <> "" Then
            .CommandType = adCmdStoredProc
            .CommandText = m_storedProc
        Else
            .CommandType = adCmdText
            .CommandText = query
        End If

        If Not m_sqlParams Is Nothing Then
            For Each param In m_sqlParams
                .Parameters.Append param
            Next
        End If

        ' NOTE:
        '
        ' rowAffected variable return a value when your command is Update, Insert and Delete ONLY.
        ' Select statement will return a -1 value. Use ExecuteCommand() or ExecuteQuery() instead.

        cmd.Execute rowAffected
        ExecuteNonCommand = rowAffected

    End With

    conn.Close

    Set cmd = Nothing
    Set conn = Nothing
    Set m_sqlParams = Nothing

    Exit Function

TransError:
    conn.Close

    Set cmd = Nothing
    Set conn = Nothing
    Set m_sqlParams = Nothing

    MsgBox Err.Description
End Function

Public Function ExecuteCommand() As Recordset
On Error GoTo TransError

    Dim param As New ADODB.Parameter

    ' Clear any error first
    Err.Clear

    If m_connString = "" Then
        Err.Raise 22001, "DBConnection class", "No valid connection string. Make sure you supply connection string property in DBConnection class."
    End If

    Set conn = New ADODB.Connection
    With conn
        .CursorLocation = adUseClient
        .ConnectionString = m_connString
        .ConnectionTimeout = 120
        .CommandTimeout = 120
        .Open
    End With

    Set cmd = New ADODB.Command
    With cmd
        .ActiveConnection = conn
        .CommandType = adCmdStoredProc
        .CommandText = m_storedProc

        If Not m_sqlParams Is Nothing Then
            For Each param In m_sqlParams
                .Parameters.Append param
            Next
        End If

        rs.CursorType = adOpenForwardOnly
        rs.CursorLocation = adUseClient
        rs.LockType = adLockOptimistic

        Set rs = cmd.Execute
        Set ExecuteCommand = rs
    End With

    Set rs = Nothing
    Set cmd = Nothing
    Set conn = Nothing
    Set m_sqlParams = Nothing

    Exit Function

TransError:
    rs.Close
    conn.Close

    Set cmd = Nothing
    Set conn = Nothing
    Set m_sqlParams = Nothing

    MsgBox Err.Description
End Function

Public Function ExecuteQuery(query As String) As Recordset
On Error GoTo TransError

    Dim param As New ADODB.Parameter

    ' Clear any error first
    Err.Clear

    If m_connString = "" Then
        Err.Raise 22001, "DBConnection class", "No valid connection string. Make sure you supply connection string property in DBConnection class."
    End If

    Set conn = New ADODB.Connection
    With conn
        .CursorLocation = adUseClient
        .ConnectionString = m_connString
        .ConnectionTimeout = 120
        .CommandTimeout = 120
        .Open
    End With

    Set cmd = New ADODB.Command
    With cmd
        .ActiveConnection = conn
        .CommandType = adCmdText
        .CommandText = query

        If Not m_sqlParams Is Nothing Then
            For Each param In m_sqlParams
                .Parameters.Append param
            Next
        End If

        rs.CursorType = adOpenStatic
        rs.CursorLocation = adUseClient
        rs.LockType = adLockOptimistic

        'rs.Open .CommandText, conn, adOpenForwardOnly, adLockOptimistic
        Set rs = cmd.Execute
        Set ExecuteQuery = rs
    End With

    Set rs = Nothing
    Set cmd = Nothing
    Set conn = Nothing
    Set m_sqlParams = Nothing

    Exit Function

TransError:
    rs.Close
    conn.Close

    Set cmd = Nothing
    Set conn = Nothing
    Set m_sqlParams = Nothing

    MsgBox Err.Description
End Function

' *********************************************************************************************
' Function ExecStoredProc
'
' Description:      Executes a SQL stored procedure within the specified database,
'                   using parameters passed by the user. Uses a parameter array
'                   to accept and store any possible number of supplied parameters
' Inputs:           Stored procedure name, connection string, name of returned recordset,
'                   stored procedure parameters (any number allowed)
' Outputs:          Returns an integer value representing the SQL stored procedure
'                   return code. 0 = success, -1 indicates VB error,
' Author:           Kevin Chadwick
'
' ---------------------------------------------------------------------------------------------
' Ammendments
' *********************************************************************************************

Private Function ExecStoredProc(ByVal vstrSpName As String, ByRef robjRecordSet As ADODB.Recordset, _
    ParamArray vntArray()) As Integer

    ' On error
    On Error GoTo ExecStoredProcError

    ' Declare the variables
    Dim objCommand As ADODB.Command
    Dim intCurrentParameter As Integer

    ' Create the objects
    Set objCommand = New ADODB.Command

    With conn
        .ConnectionString = m_connString
        .ConnectionTimeout = 120
        .CommandTimeout = 120
        .Open
    End With

    ' Make it an active connection
    objCommand.ActiveConnection = conn

    'Declare the command object as a stored procedure
    objCommand.CommandType = adCmdStoredProc
    objCommand.CommandText = vstrSpName 'supplied by calling program

    'Get the supplied parameters from the ParamArray and assign them to the command object
    objCommand.Parameters.Append objCommand.CreateParameter("RetValue", _
        adInteger, adParamReturnValue) 'delcares the SQL return value

    For intCurrentParameter = 1 To (UBound(vntArray) + 1)
        If vntArray(intCurrentParameter - 1) <> "" Then
            objCommand.Parameters.Append objCommand.CreateParameter("Parameter" _
            & intCurrentParameter, adVarChar, adParamInput, Len(vntArray(intCurrentParameter - 1)), vntArray(intCurrentParameter - 1))
        Else
            objCommand.Parameters.Append objCommand.CreateParameter("Parameter" _
            & intCurrentParameter, adVarChar, adParamInput, 1)
        End If
    Next intCurrentParameter

    'Get the recordset back
    Set robjRecordSet = New ADODB.Recordset
    robjRecordSet.CursorLocation = adUseClient
    Set robjRecordSet = objCommand.Execute

    'Clean up, send the SQL return code back to the calling program, and exit
    ExecStoredProc = objCommand.Parameters(0).Value 'send return code back
    Set objCommand = Nothing


    '--Error Handling--
ExecStoredProcError:
    ' Add your error handling here
    MsgBox Err.Number & ": " & Err.Description

End Function