VBA to SQL Stored Procedure function

[antfran]

I've no blog or website to post things to at the moment so I've
decided to put this here to help anyone trying to call SQL stored
procedures from within VBA

any questions, comments or just want a chat then drop me a mail... I
might or might not get back to you depending on what I'm doing at the
time.

if you use it then at least give me a little credit

Ps... Not sure how the code is gonna look in post! this is the first
try.

'/*
MODULE******************************************************************************************
'-- NAME : DoDatabaseThings
'-- PURPOSE : Create ADO Connection string, execute SQL Stored
Procedures
'
'-- AUTHOR : Anthony Francis
'-- CREATION DATE: 12/02/2008
'************************************************************************************************
*/

Option Explicit
Public Const DbSource = "ServerName" 'Server name
Public Const UseDatabase = "Database" 'database on server


Function ExecSP_ADO(SPName As String, inParamNames As Variant,
inParamValues As Variant, _
ReportBack As Boolean, Optional outParamName As
Variant) As Variant

'/*
FUNCTION****************************************************************************************
'-- NAME : ExecSP_ADO
'-- PURPOSE : Universal VBA Function to call SQL stored
procedures,pass parameter NAMES and
' VALUES and handle RETURN VALUES
'
'-- AUTHOR : Anthony Francis
'-- CREATION DATE: 12/02/2008
'-- USAGE : ExecSP_ADO SPName, inParamNames, inParamValues
'
'-- ARGUMENTS : SPName As String
' -Name of Stored Procedure to Execute
'
' inParamNames As Variant
' -Array of Parameter VALUES for Stored
Procedure
'
' inParamValues As Variant
' -Array of Parameter VALUES for Stored
Procedure
'
' ReportBack As Boolean
' -TRUE or FALSE:
' TRUE will return output parameter supplied
from outParamName
' FALSE will ignore any output values
'
' outParamName As Variant (Optional)
' -if ReportBack = TRUE a @RETURN_VALUE from the
is required
'
'--TO DO LIST : Multiple return values (not used in this project)
'
'-- HISTORY :
CREATED 06/02/2008 Anthony
Francis
' : CHANGE - Added output parameter
handling 12/02/2008 Anthony Francis
'
'************************************************************************************************
*/

Dim cnn As ADODB.Connection
Dim rstRecordset As ADODB.Recordset
Dim cmdCommand As ADODB.Command
Dim i As Long
Dim x As Variant
Dim NameArray() As Variant
Dim ValueArray() As Variant

On Error GoTo ErrHandler:

i = 0
For i = LBound(inParamNames) To UBound(inParamNames)
Next i
ReDim NameArray(0 To i)
i = 0
For i = LBound(inParamNames) To UBound(inParamNames)
NameArray(i) = inParamNames(i)
Next i
i = 0
For i = LBound(inParamValues) To UBound(inParamValues)
Next i
ReDim ValueArray(0 To i)
i = 0
For i = LBound(inParamValues) To UBound(inParamValues)
ValueArray(i) = inParamValues(i)
Next i


' Open the connection.
Set cnn = New ADODB.Connection
cnn.Open DbConnection


' Set the command text.
Set cmdCommand = New ADODB.Command
Set cmdCommand.ActiveConnection = cnn


'Execute SQL
With cmdCommand
.CommandText = SPName
.CommandType = adCmdStoredProc
For i = LBound(NameArray) To UBound(NameArray) - 1
.Parameters(NameArray(i)) = ValueArray(i)
Next i
.Execute
If ReportBack = True Then
x = .Parameters(outParamName)
End If
End With

'Set function to returned data
If IsNull(x) = False Then ExecSP_ADO = x

' Close the connections and clean up.
cnn.Close
Set cmdCommand = Nothing
Set rstRecordset = Nothing
Set cnn = Nothing

Exit Function
ErrHandler:
MsgBox Err.Description & " | " & Err.Number, vbCritical

End Function



Function DbConnection()

'/*
FUNCTION****************************************************************************************
'-- NAME : DBConnection
'-- PURPOSE : Create ADO Connection string
'
'-- AUTHOR : Anthony Francis
'-- CREATION DATE: 12/02/2008
'************************************************************************************************
*/

DbConnection = "Provider=sqloledb;"
DbConnection = DbConnection & "Data Source=" & DbSource & ";"
DbConnection = DbConnection & "Initial catalog=" & UseDatabase &
";"
DbConnection = DbConnection & "Integrated Security = SSPI;"

End Function