[AccessD] Stored procedures from Access

I went out to the internet to that site with all of the 
connection strings.  That didn't work, which just points out 
how a little data in the hands of someone with no knowledge 
is pretty much useless.  ;-)

I ended up using the connection stuff provided by Martin, 
dynamically strung together using the server / database I 
choose.

That ended up working.  The only changes I made were to the 
area around the cnn object.  Other than that your function 
functions beautifully.

This is what I ended up with:

Dim strCnn As String

Function mTrustedConnection(strServerName As String, 
strDatabase As String)
     strCnn = "Provider=sqloledb;"
     strCnn = strCnn & "Source=" & strServerName & ";"
     strCnn = strCnn & "Initial Catalog=" & strDatabase & ";"
     strCnn = strCnn & "Integrated Security=SSPI;"
     mTrustedConnection = strCnn
End Function
'CallADOStoredProc(ByVal SPName As String, ParamArray 
Params() As Variant)

Public Function CallADOStoredProc(strServerName As String, 
strDatabase As String, _
                                     ByVal SPName As String, _
                                     ParamArray Params() As 
Variant)
   'Created by Charlotte Foust 9/30/2000
   'last modified 1/12/2001
   'Calls a saved query or stored procedure
   On Error GoTo Proc_err
   Dim varValue As Variant
   Dim strSQL As String
   Dim intLoop As Integer
   Dim varPrmType As Variant
   Dim lngRecords As Long


   Dim cnn As ADODB.Connection
   Dim cmd As ADODB.Command
   Dim errCurr As ADODB.Error
   Dim colErrs As ADODB.Errors

   Const ERR_OPER_ON_INVALID_CONNECTION = 3709
   Const ERR_RECORD_IS_DELETED = -2147467259

   Set cnn = New ADODB.Connection
   cnn.ConnectionString = mTrustedConnection(strServerName, 
strDatabase)
   cnn.CursorLocation = adUseClient

   'this simplifies accessing the errors
   'collection, which belongs to the
   'connection
   Set colErrs = cnn.Errors

   cnn.Open

   Set cmd = New ADODB.Command
   With cmd
     .ActiveConnection = cnn
     'this could also be written as
     'colErrs.Clear
     .ActiveConnection.Errors.Clear
     .CommandType = adCmdStoredProc
     .CommandText = SPName

     For intLoop = LBound(Params) To UBound(Params)
       Select Case VarType(Params(intLoop))
         Case vbString
           varPrmType = adVarWChar
         Case vbLong
           varPrmType = adBigInt
         Case vbDate
           varPrmType = adDate
           'if SQL Server, use adDBTimeStamp
         Case vbInteger
           varPrmType = adSmallInt
         Case vbDouble
           varPrmType = adDouble
         Case vbSingle
           varPrmType = adSingle
         Case vbBoolean
           varPrmType = adBoolean
         Case vbCurrency
           varPrmType = adCurrency
            Case vbByte
           varPrmType = adUnsignedTinyInt
         Case vbNull
           varPrmType = Null
         Case Else
           'WARNING!  Not supported in ADO 2.5
           varPrmType = adVariant
       End Select
       If varPrmType = adVarWChar Then
         .Parameters.Append .CreateParameter( _
               "prm" & intLoop, varPrmType, adParamInput, 
Len(Params(intLoop)) + 2, Params(intLoop))
       Else
         'you have to create ALL the parameters
         .Parameters.Append .CreateParameter( _
               "prm" & intLoop, varPrmType, adParamInput, , 
Params(intLoop))
       End If 'varPrmType = adVarWChar
     Next intLoop
     .Execute RecordsAffected:=lngRecords, 
Options:=adCmdStoredProc
   End With
Proc_exit:
   On Error Resume Next
   CallADOStoredProc = lngRecords
   Set cmd = Nothing
   Exit Function
Proc_err:
   'ADO errors and Jet errors aren't the same
   'collection, so this handles them differently
   If colErrs.Count > 0 Then
     'There are ADO errors
     For Each errCurr In colErrs
       Select Case errCurr
         Case ERR_OPER_ON_INVALID_CONNECTION
         Stop
           Resume Proc_exit
         Case Else
             MsgBox errCurr.Number & "--" _
                     & errCurr.Description & " (" _
                     & errCurr.Source & ")"
             Resume Proc_exit
       End Select
     Next errCurr
     colErrs.Clear
   Else
     'there is an other error
     MsgBox Err.Number & "--" & Err.Description
     Resume Proc_exit
   End If
     Resume 0
End Function

John W. Colby
www.ColbyConsulting.com


Charlotte Foust wrote:
> I don't see a provider in that connection string, John.
> 
> Charlotte Foust