Usefull information about passing parameters to Stored Procedures 5

[SundancerKid]

When running reports in ADP and you are passing parameters you will be using Stored Procedures.

Reference to passing parameters will be referenced in the Input Parameters field under the Report properties.

Reference to passing parameters for forms you will be using VBA for Forms.

Report::::
Example of a Stored Procedure that I created

Alter PROCEDURE [Booth Procedure]
@Select_Show int
As
SELECT shows.s_name, contracts.con_booth_assigned,
contracts.con_booth_sqft, exhibitors.e_name, shows.s_facility, convert( int, rtrim(contracts.con_booth_assigned)) as BOOTH
FROM contracts INNER JOIN
exhibitors ON contracts.e_id = exhibitors.e_id INNER JOIN
shows ON contracts.s_id = shows.s_id
WHERE dbo.contracts.s_id = @Select_Show

Report (Main) Properties

Input Parameters @Select_Show = Forms![frm_SelectShowDialog]![SelectShow]

Form using a List Box

VBA Code:

Private Sub Last_Click()
' --- This resets the query for the last names ----
Dim FoundLastName As String

FoundLastName = Forms![frm_record_find].FindLastName
FoundLastName = "%" + FoundLastName + "%"

Me.List19.RowSource = "Exec FindLastName @LName = ' " &
FoundLastName & " ' "

Me.Repaint ' Save data for query
Me.Refresh ' Requery drop down listing
End Sub

Stored Procedure used:

Alter Procedure FindLastName
@LName as varchar(30)
As
SELECT DISTINCT
buyers.store_id as StoreID, buyers.buy_lname as Last,
buyers.buy_fname as First, stores.store_name as Store
FROM buyers INNER JOIN
stores ON buyers.store_id = stores.store_id
WHERE (buyers.buy_lname LIKE @LName)
ORDER BY buyers.buy_lname
return

I hope some of this help everyone.

Thanks to everyone that helped me.

 

[Pizarro]

Thank you very much for the valuable information.
You have jump started my projects!

God Bless!

Regards - Pizarro

 

[SundancerKid]

I am glad I could help.

 

[LowBrow]

Thanks! I have been searching and made a couple of posts over the last few days and this has helped me a ton!

 

[ESquared]

For what it's worth, you need to be careful about SQL injection. Your FoundLastName variable could have maliciously crafted search strings typed in such as

';TRUNCATE TABLE Users;
which because of the closing single quote and the semicolons should run regardless of any errors in other parts.

You can avoid this by replacing single quotes with double quotes.

 

[CodeMania]

Hi SundancerKid

Found your post handy but I Hop you can help me some more. Hope that I’m not intruding I’m desperate for help after 3 day of looking for a solution.

I have a Update Store procedure in SQL that works fine when I enter the parameter inputs.

Here it is:

INSERT INTO dbo.tbl_CA_Unicenter_Hi_Lo_Event
(Organisatie, Systemen, Event, Aantal, Datum)
SELECT Organisatie, Systeem, Event, COUNT(*) AS Totaal, @MaandJaarDatum AS Datum
FROM dbo.tbl_CA_Unicenter_NSM
WHERE (Datum > @StartDatum) AND (Datum < @EindDatum) AND (Organisatie = @Organisatienaam)
GROUP BY Organisatie, Systeem, Event
ORDER BY Organisatie, Systeem

Now I would like to replace to parameters with some input from a Access adp form.

Here are the form input locations:

[Forms]![frm_Rapportages]![StartDatum]
must replace @StartDatum

[Forms]![frm_Rapportages]![Einddatum]
must replace @EindDatum

[Forms]![frm_Rapportages]![Organisatienaam]
must replace @Organisatienaam

And

@MaandJaarDatum has to accept a Month Year format (10-2005) from VB Code Like this: Format(DatePart("m", Get_Date(cFirstofLastMonth)), "00") & -DatePart("yyyy", Get_Date(cFirstofLastMonth))

In Access this worked fine but now that I am converting everything to SQL and a Access adp it seems to work different.

Here is the original Access SQL statement:

INSERT INTO [tbl_Hi-Lo_Event] ( Organisatie, Systemen, Event, Aantal, Datum )
SELECT tbl_CA_Unicenter_NSM.Organisatie, tbl_CA_Unicenter_NSM.Systeem, tbl_CA_Unicenter_NSM.Event, Sum(+1) AS Aantal, Format(DatePart("m",Forms!frm_Report_Selector!StartDate00),"00") & -DatePart("yyyy",Forms!frm_Report_Selector!StartDate00) AS Datum
FROM tbl_CA_Unicenter_NSM
WHERE (((tbl_CA_Unicenter_NSM.Datum)>=[Forms]![frm_Report_Selector]![StartDate00] And (tbl_CA_Unicenter_NSM.Datum)<=[Forms]![frm_Report_Selector]![EndDate24]))
GROUP BY tbl_CA_Unicenter_NSM.Organisatie, tbl_CA_Unicenter_NSM.Systeem, tbl_CA_Unicenter_NSM.Event, Format(DatePart("m",Forms!frm_Report_Selector!StartDate00),"00") & -DatePart("yyyy",Forms!frm_Report_Selector!StartDate00)
HAVING (((tbl_CA_Unicenter_NSM.Organisatie) Like [Forms]![frm_Report_Selector]![cboOrg]))
ORDER BY tbl_CA_Unicenter_NSM.Organisatie, tbl_CA_Unicenter_NSM.Systeem;

 

[CodeMania]

Hi SundancerKid

Sorry for the intrusion, thought it would be no problem.

I found A solution that works 100%. Hop that it will help everyone reads your POST. Thought it would be no problem.

cFirstofLastMonth and cFirstofLastMonth is code that works out the month start and end date.

VB Code: That works with Store Procedure Parameters

Public Function HiLoEventTabelUpdate()

Dim db As Database, rst As ADODB.Recordset, VorigeMaandJaarDatum

VorigeMaandJaarDatum = Format(DatePart("m", Get_Date(cFirstofLastMonth)), "00") & -DatePart("yyyy", Get_Date(cFirstofLastMonth))


Dim cnn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim param1 As ADODB.Parameter, param2 As ADODB.Parameter, param3 As ADODB.Parameter, param4 As ADODB.Parameter

' Connect
Set cnn = CurrentProject.Connection

Set cmd.ActiveConnection = cnn

' Set up a command object for the stored procedure.
cmd.CommandText = "dbo.spHiLoEventsUpdate"
cmd.CommandType = adCmdStoredProc

Set param1 = cmd.CreateParameter("@StartDatum", adDBDate, adParamInput)
cmd.Parameters.Append param1
param1.Value = [Forms]![frm_Rapportages]![StartDatum]
Set param2 = cmd.CreateParameter("@EindDatum", adDBDate, adParamInput)
cmd.Parameters.Append param2
param2.Value = [Forms]![frm_Rapportages]![Einddatum]
Set param3 = cmd.CreateParameter("@Organisatienaam", adVarChar, adParamInput, 50)
cmd.Parameters.Append param3
param3.Value = [Forms]![frm_Rapportages]![Organisatienaam]
Set param4 = cmd.CreateParameter("@MaandJaarDatum", adVarChar, adParamInput, 10)
cmd.Parameters.Append param4
param4.Value = VorigeMaandJaarDatum

' Execute command to run stored procedure
cmd.Execute

End Function

Store Procedure: That works with VB Code

INSERT INTO dbo.tbl_CA_Unicenter_Hi_Lo_Event (Organisatie, Systemen, Event, Aantal, Datum)
SELECT Organisatie, Systeem, Event, COUNT(*) AS Totaal, @MaandJaarDatum AS Datum
FROM dbo.tbl_CA_Unicenter_NSM
WHERE (Datum > @StartDatum) AND (Datum < @EindDatum) AND (Organisatie = @Organisatienaam)
GROUP BY Organisatie, Systeem, Event
ORDER BY Organisatie, Systeem

 

[ESquared]

Good work, CodeMania.

Here's some code I wrote to run stored procedures with unlimited parameters. Not only does it run the stored procedure, but it returns any integer return value from the stored procedure, which can be quite handy such a returning the identity value from an insert.

Public Function SPExecReturn(TheStoredProcedure As String, ParamArray TheInput() As Variant) As Variant
   On Error GoTo SPExecReturn_Error
   Dim dbC As New ADODB.Command
   Dim iCntr As Long
   Dim iLBound As Long
   Dim iUBound As Long
   
   With dbC
      Set .ActiveConnection = Application.CurrentProject.Connection
      .CommandText = TheStoredProcedure
      .Parameters.Append .CreateParameter("RetVal", adVariant, adParamReturnValue)
      iLBound = LBound(TheInput())
      iUBound = UBound(TheInput())
      For iCntr = iLBound To iUBound
         If VarType(TheInput(iCntr)) = vbString Then
            .Parameters.Append .CreateParameter( _
                  , _
                  ADOVarType(TheInput(iCntr)), _
                  adParamInput, _
                  Len(TheInput(iCntr)), _
                  TheInput(iCntr) _
               )
         Else
            .Parameters.Append .CreateParameter( _
                  , _
                  ADOVarType(TheInput(iCntr)), _
                  adParamInput, _
                  , _
                  TheInput(iCntr) _
               )
         End If
      Next
      .Prepared = False 'True
      .Execute , , adExecuteNoRecords + adCmdStoredProc
      SPExecReturn = .Parameters!RetVal
   End With

SPExecReturn_Exit:
   Set dbC = Nothing
   Exit Function
   
SPExecReturn_Error:
   MsgBox "Error #" & Err.Number & " in " & Err.Source & ":" & vbCrLf & Err.Description, vbExclamation, "Server data read error"
   On Error GoTo 0
   Stop
   Resume
   GoTo SPExecReturn_Exit
End Function

Public Function ADOVarType(TheVariable As Variant) As ADODB.DataTypeEnum
   On Error GoTo ADOVarType_Error
   If (VarType(TheVariable) And vbArray) <> 0 Then
      Err.Raise vbObjectError + 20000, "PermitManager.basUtil.ADOVarType", "Variables of type " & VarTypeName(TheVariable, , False) & " [" & VarTypeName(TheVariable, True) & "] cannot be used as ADO parameters."
      Exit Function
   End If
   Select Case VarType(TheVariable) And Not vbArray
      Case vbString: ADOVarType = adVarChar
      Case vbLong: ADOVarType = adInteger
      Case vbInteger: ADOVarType = adSmallInt
      Case vbNull: ADOVarType = adInteger
      Case vbBoolean: ADOVarType = adBoolean
      Case vbByte: ADOVarType = adTinyInt
      Case vbCurrency: ADOVarType = adCurrency
      Case vbDate: ADOVarType = adDate
      Case vbDecimal: ADOVarType = adDecimal
      Case vbDouble: ADOVarType = adDouble
      Case vbEmpty: ADOVarType = adEmpty
      Case vbError: ADOVarType = adError
      Case vbSingle: ADOVarType = adSingle
      Case vbUserDefinedType: ADOVarType = adUserDefined
      Case vbVariant 'only used for arrays of variants
         Err.Raise vbObjectError + 20001, "ADOVarType", "Variables of type " & VarTypeName(TheVariable, , False) & " [" & VarTypeName(TheVariable, True) & "] cannot be used as ADO parameters."
      Case vbDataObject
         Err.Raise vbObjectError + 20002, "ADOVarType", "Variables of type " & VarTypeName(TheVariable, , False) & " [" & VarTypeName(TheVariable, True) & "] cannot be used as ADO parameters."
      Case vbObject
         Err.Raise vbObjectError + 20003, "ADOVarType", "Variables of type " & VarTypeName(TheVariable, , False) & " [" & VarTypeName(TheVariable, True) & "] cannot be used as ADO parameters."
   End Select
   
ADOVarType_Exit:
   Exit Function
   
ADOVarType_Error:
   Select Case Err.Number
      Case vbObjectError + 20000 To vbObjectError + 20003
         MsgBox "Error in " & Err.Source & ":" & vbCrLf & Err.Description, vbExclamation + vbOKOnly, "Incorrect variable type"
      Case Else
         On Error GoTo 0
         Resume
   End Select
End Function

Function VarTypeName(TheVariable As Variant, Optional fFullDesc As Boolean = False, Optional fArrayInfo As Boolean = True) As String
   Dim asInfo As Variant
   Dim iLBound As Long
   Dim iLookupVal As Long
   
   asInfo = Array("Empty", "Empty (uninitialized)", "Null", "Null (no valid data)", "Integer", "Two-byte signed integer", "Long", "Four-byte signed integer", "Single", "Single-precision floating-point number", "Double", "Double-precision floating-point number", "Currency", "Currency value", "Date", "Date value", "String", "String", "Object", TypeName(TheVariable), "Error", "Error value", "Boolean", "Boolean value", "Variant", "Variant", "DataObject", "A data access object", "Decimal", "Decimal value", "UserDefinedType", "Variants that contain user-defined types", "Array", "Array", "Byte", "One-byte unsigned integer")
   iLookupVal = VarType(TheVariable) And IIf(fArrayInfo, Not vbArray, Not 0)
   If iLookupVal And vbArray Then
      iLookupVal = 16
   ElseIf iLookupVal = vbUserDefinedType Then
      iLookupVal = 15
   End If
   VarTypeName = asInfo(iLookupVal * 2 + IIf(fFullDesc, 1, 0))
   If fArrayInfo And ((VarType(TheVariable) And vbArray) <> 0) Then
      VarTypeName = "Array of " & VarTypeName
      On Error Resume Next
      iLBound = LBound(TheVariable)
      If Err.Number = 9 Then
         Err.Clear
         VarTypeName = VarTypeName & " (Empty)"
      Else
         VarTypeName = VarTypeName & " (" & CStr(iLBound) & " To " & CStr(UBound(TheVariable)) & ")"
      End If
      On Error GoTo 0
   End If
End Function

You don't have to get as fancy as I did, but I believe that the extra code on the front end saves the server a lot of work.

You might like the VarTypeName function for development, anyway... it saves time looking up VarType return values (although I suggest you not use it in release code except where generating human-readable output).

For full example code:

CREATE PROCEDURE MyProc @MyVal int
AS
DECLARE @MyID int, @Error int, @RetVal int
INSERT MyTable (MyValue) SELECT @MyVal
SELECT @Error = @@Error, @MyID = Scope_Identity()
IF @Error <> 0 THEN
   SET @RetVal = -1
ELSE
   SET @RetVal = @MyID
RETURN @MyID

Debug.Print SPExecReturn("MyProc", 12345)

 

[CodeMania]

Thanks ESquared

Thanks for your replay. Indeed you are correct. I like your code a lot and the VarTypeName dose interest me a lot, because this was where I had a lot of problems that needed to be solved. I will make some alterations and improvements to benefit from.

ESquared hop I’m not imposing too much on you as to my next question.

I have a cross table Query in Access that needs to be converted to a cross table stored procedure on the SQL Server. Is this possible and if indeed could you help me because I have no idée as to how this is dun in SQL. Converting a Access DB to Access ADP is new to me.

Here is my Cross table Query from Access DB:

TRANSFORM Sum(tbl_Hi_Lo_Event.Aantal) AS SomVanAantal
SELECT tbl_Hi_Lo_Event.Systemen, tbl_Hi_Lo_Event.Event
FROM tbl_Hi_Lo_Event
WHERE ((([tbl_Hi-Lo_Event].[Organisatie])=OrganizationName()))
GROUP BY tbl_Hi_Lo_Event.Systemen, tbl_Hi_Lo_Event.Event
PIVOT tbl_Hi_Lo_Event.Datum;

You will se that OrganizationName() is a reverens to VB code that this Cross table query uses to find a Organization name witch is based form input. It is simple but effective.

Here is the simple code I used:

Option Compare Database
Option Explicit
Public strOrganizationName As String

Public Function OrganizationName()
Dim db As Database, rst As Recordset, MyOrganizationName

MyOrganizationName = [Forms]![frm_Report_Selector]![cboOrg]

Set db = CurrentDb

Set rst = db.OpenRecordset("tbl_Hi-Lo_Event")

'Vul the Recordset
rst.MoveLast

rst.MoveFirst

'Find record in Recordset that matches
While Not (rst.EOF)
If (rst![Organisatie] = MyOrganizationName) Then

'Use Criteria (Recordset) as Parameter for Query
strOrganizationName = MyOrganizationName
OrganizationName = strOrganizationName

Exit Function

End If

rst.MoveNext

Wend

End Function

Thanks in advance for your help.

 

[ESquared]

There's no easy way; search the SQL Server forum for specifics on Pivot or cross-tab queries. I and others have covered them on Tek-Tips many times.

 

[CodeMania]

Esquared thanks will do. I will post my solution and what I found to help me soon.

Like to thank you for your help and code thus fare. It helps me a lot.

 

[ESquared]

By the way, I found a bug in SPExecReturn... you can't pass in empty strings "" because ADO complains about character type parameters with length 0. So either just add one (with potential conflicts with near-full fields) or add code for setting the minimum field length on a string to 1.

Also, I see I didn't take out my debug code at the end for actually seeing full error messages on the line they occurred on (on error goto 0, resume). Feel free to take that out.

Last, here's my latest improvement to the error handling on SPExecReturn:

SPExecReturn_Error:
   With Err
      If .Number = &H80040E14 Then
         Dim sTitle As String
         Dim sDescription As String
         If .Description Like "*^*" Then
            sTitle = Left(.Description, InStr(.Description, "^") - 1)
            sDescription = Right(.Description, Len(.Description) - Len(sTitle) - 1)
         Else
            sTitle = "SQL Server Procedural Error"
            sDescription = .Description
         End If
         Eval "MsgBox(""" & sDescription & """, " & vbExclamation & " , """ & sTitle & """)"
      Else
         Eval "MsgBox(""Error " & Err.Number & " in " & Err.Source & "@@" & Err.Description & """, " & vbExclamation & " , ""SQL Server Error"")"
      End If
      On Error GoTo 0
      GoTo SPExecReturn_Exit
   End With
End Function

If you now, in your stored procedure, do something like the following, you can get some pretty fancy error messages passed back to the user:

CREATE PROCEDURE CreateSomeEntity @TheInput varchar(100)
AS
DECLARE
   @M varchar(200),
   @Id int,
   @Error int
SET @M = ''

BEGIN TRANSACTION
   --Do some stuff with the passed parameter
   SELECT @Error = @@ERROR, @Id = Scope_Identity()
   IF @@ERROR <> 0 OR 1=1 BEGIN SET @M = 'Context-sensitive error message' GOTO FatalError END -- 1=1 to force error condition
   --Finish doing stuff

COMMIT TRANSACTION -- if we got this far it was successful
RETURN @Id

FatalError:
ROLLBACK TRANSACTION -- undo any data changes we made before the error
SET @M = 'SQL Server Procedural Error^Cannot Create Entity@@' + @M
RAISERROR (@M, 16, 1)

I chose ^ to separate the caption from the error message. Also, you can put something in each section, before, between, and after the @ symbols (anything before the first @ symbol is in bold). Last, use of the Eval command is required to get the @ symbols to make any special formatting, as the Office MsgBox parser doesn't do the trick, and Eval lets you force the Access MsgBox parser to do it.

Iff you'd liked to see a sample of the kind of error messages the function produces, add this stored procedure and then go to the immediate pane (Ctrl-G in VB editor) and type
?SPExecReturn("CreateSomeEntity", "blah")
and pressing Enter.

 

[CodeMania]

Esquared I will try this out, looks grate and its always nice to do something else that a user can appreciate.

By the whey I found a post with some info. I’m cowing to build it an then post is when it’s working good. Thanks once again for your help.

 

[dwight1]

Thank you all for this useful thread.

Sundancerkid,
I want to create a duplicate record in a table basing on my selection on a combo box id. I run the following code on the sql server

Insert Into <table> (col list excluding identity)
Select (col list excluding identity)
From <table>
Where <table>.id = <some id>

It asks me for the id and input some id and it copies the record.

Now the problem is passing @id parameter to the click event of the access form. I want the id that is selected in the combo to duplicate and i am having problems passing the parameter. Can any one please help me with the click event code to pass a parameter.

Thanks in advance for the help.

Dwight

 

[dwight1]

Cont....

Pls find the code that i am running behind the click event

Private Sub Command30_Click()
On Error GoTo Err_Command30_Click

Dim stDocName As String
Dim appid As String 'appid is the parameter the sp is looking for'

stDocName = "z1" 'this is the sp'
appid = Forms!updatedit_switchboard.Combo8 'this is the forms field name'
appid = "%" + appid + "%"
Me.Combo8 = "exec z1 @appid = ' " & appid & "'"
Me.Repaint
Me.Refresh

DoCmd.OpenStoredProcedure stDocName, acViewNormal, acEdit

Exit_Command30_Click:
Exit Sub

I am not good at vb so pardon me if it looks bad.

Dwight

 

[ESquared]

what is the name of the combo box? appid?
you can specifically reference the control with Me.Controls("ControlName")
you can also try Me!ControlName but this can resolve to a field name in your recordset rather than the control, if there's one by the same name.

 

[dwight1]

The name of the combo is Combo8.
Appid(numeric) is the selection in combo that requires to be copied/duplicated to create record in the table.
I tried giving parameters like below it does not work.

ME.combo8 = @appid

Any suggestions

Dwight

 

[ESquared]

setting combo8 to a value just changes the value of the combo. And if the value is in the list, that item will be displayed, otherwise nothing will be displayed. if you want to change the rowsource you have to use combo8.rowsource.

I rather think you're hopelessly lost. Good luck with it.

 

[CodeMania]

Hi ESquared's

It took me a bit of time to find a solution that works fine for now.

The only thing now is that I need to make this stored procedure Dynamic. If you have any suggestions, Pleas post them here for me. Thanks in advance.

Here is My SQL Cross table Solution.

SELECT Systemen, Event, SUM(CASE WHEN Datum = '01-2005' THEN Aantal ELSE 0 END) AS '01-2005',
SUM(CASE WHEN Datum = '02-2005' THEN Aantal ELSE 0 END) AS '02-2005', SUM(CASE WHEN Datum = '03-2005' THEN Aantal ELSE 0 END)
AS '03-2005', SUM(CASE WHEN Datum = '04-2005' THEN Aantal ELSE 0 END) AS '04-2005',
SUM(CASE WHEN Datum = '05-2005' THEN Aantal ELSE 0 END) AS '05-2005', SUM(CASE WHEN Datum = '06-2005' THEN Aantal ELSE 0 END)
AS '06-2005', SUM(CASE WHEN Datum = '07-2005' THEN Aantal ELSE 0 END) AS '07-2005',
SUM(CASE WHEN Datum = '08-2005' THEN Aantal ELSE 0 END) AS '08-2005', SUM(CASE WHEN Datum = '09-2005' THEN Aantal ELSE 0 END)
AS '09-2005', SUM(CASE WHEN Datum = '10-2005' THEN Aantal ELSE 0 END) AS '10-2005',
SUM(CASE WHEN Datum = '11-2005' THEN Aantal ELSE 0 END) AS '11-2005', SUM(CASE WHEN Datum = '12-2005' THEN Aantal ELSE 0 END)
AS '12-2005', SUM(CASE WHEN Datum = '01-2006' THEN Aantal ELSE 0 END) AS '01-2006',
SUM(CASE WHEN Datum = '02-2006' THEN Aantal ELSE 0 END) AS '02-2006', SUM(CASE WHEN Datum = '03-2006' THEN Aantal ELSE 0 END)
AS '03-2006', SUM(CASE WHEN Datum = '04-2006' THEN Aantal ELSE 0 END) AS '04-2006',
SUM(CASE WHEN Datum = '05-2006' THEN Aantal ELSE 0 END) AS '05-2006', SUM(CASE WHEN Datum = '06-2006' THEN Aantal ELSE 0 END)
AS '06-2006', SUM(CASE WHEN Datum = '07-2006' THEN Aantal ELSE 0 END) AS '07-2006',
SUM(CASE WHEN Datum = '08-2006' THEN Aantal ELSE 0 END) AS '08-2006', SUM(CASE WHEN Datum = '09-2006' THEN Aantal ELSE 0 END)
AS '09-2006', SUM(CASE WHEN Datum = '10-2006' THEN Aantal ELSE 0 END) AS '10-2006',
SUM(CASE WHEN Datum = '11-2006' THEN Aantal ELSE 0 END) AS '11-2006', SUM(CASE WHEN Datum = '12-2006' THEN Aantal ELSE 0 END)
AS '12-2006'
FROM dbo.tbl_CA_Unicenter_Hi_Lo_Event
WHERE (Organisatie = @Organisatienaam)
GROUP BY Systemen, Event
ORDER BY Systemen

‘’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’
Here is the VBA Code that works with the Stored Procedure.
It has become a bit divert than I intended because I had to export the cross table query to Excel with the parameter as input. The Code reacts on @Organisatienaam that is a inputs Parameter.
In short I export the parameter (witch is different etch time) to Excel documents.

I Hope that this code will help some one to.
If anybody has some comments as to improve this code, pleas do not hesitate to post it here.

Here is all the code (Module) you need.

I Replaced Some Names Du to Security reasons.
kName1-2-3 and CLIENTNAME are Client names.

Option Compare Database
Option Explicit
'=================================================================================
' The following Constants are for use in the ExportToExcel & Klant Function.
'=================================================================================

Public Datasheet As String

Public Const kName1 = "CLIENTNAME"
Public Const cName1 = "\\Server\Path to Excel file\CLIENTNAME datasheet.xls"
Public Const kName2 = "CLIENTNAME"
Public Const c Name2 = "\\Server\Path to Excel file\CLIENTNAME datasheet.xls"
Public Const k Name3 = "CLIENTNAME"
Public Const c Name3 = "\\Server\Path to Excel file\CLIENTNAME
datasheet.xls"



Public Function Klanten(Klantnaam As String)

Klantnaam = UCase(CLIENTNAME)

Select Case CLIENTNAME
Case kName1
Klantnaam = kName1
Datasheet = cName1
Call ExportToExcel(CLIENTNAME)
Case kName2
Klantnaam = kName2
Datasheet = cName2
Call ExportToExcel(CLIENTNAME)
Case kName3
Klantnaam = kName3
Datasheet = cName3
Call ExportToExcel(CLIENTNAME)

End Function


“”””””””””Found this code on the Internet.””””””””””””””


Public Function ExportToExcel(Clientname As String)

Dim cnn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rst As New ADODB.Recordset
Dim param1 As ADODB.Parameter

' Connect
Set cnn = CurrentProject.Connection
Set cmd.ActiveConnection = cnn

'Set up a command object for the stored procedure.
cmd.CommandText = "dbo. stored procedure name"
cmd.CommandType = adCmdStoredProc

Set param1 = cmd.CreateParameter("@Organisatienaam", adVarChar, adParamInput, 50)
cmd.Parameters.Append param1
param1.Value = Clientname ''[Forms]![frm_Rapportages]![Organisatienaam]
'

'Can return a recordset if desired.
Set rst = cmd.Execute

'Copy records to a named range
'on an existing worksheet on a
'workbook
'

'Copy records to first 20000 rows
'in an existing Excel Workbook and worksheet
'
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet

Dim recArray As Variant

Dim fldCount As Integer
Dim recCount As Long
Dim iCol As Integer
Dim iRow As Integer
'Dim db As Database
'Dim rs As Recordset
'Dim intLastCol As Integer
Dim conWKB_NAME As String

Dim YearMonthDate As String
YearMonthDate = DatePart("yyyy", Get_Date(cFirstofLastMonth)) & Format(DatePart("m", Get_Date(cFirstofLastMonth)), "00")

Const conMAX_ROWS = 20000
Const conSHT_NAME = "Location (Workbook) in Excel File"
conWKB_NAME = Datasheet
Const conRANGE = "RangeFrmRS"
'Set db = Currentdb
Set objXL = New Excel.Application
'Set rs = db.OpenRecordset("Customers", dbOpenSnapshot)
With objXL
.Visible = True
Set objWkb = .Workbooks.Open(conWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0

' objSht.Range(conRANGE).CopyFromRecordset rst

' intLastCol = objSht.UsedRange.Columns.Count
' With objSht
' .Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
' intLastCol)).ClearContents
' .Range(.Cells(1, 1), _
' .Cells(1, rst.Fields.Count)).Font.Bold = True
' .Range("A2").CopyFromRecordset rst

' Copy field names to the first row of the worksheet
fldCount = rst.Fields.Count
For iCol = 1 To fldCount
objSht.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name
Next

'Check version of Excel
If Val(Mid(objXL.Version, 1, InStr(1, objXL.Version, ".") - 1)) > 8 Then
'EXCEL 2000 or 2002: Use CopyFromRecordset

' Copy the recordset to the worksheet, starting in cell A2
objSht.Cells(2, 1).CopyFromRecordset rst
'Note: CopyFromRecordset will fail if the recordset
'contains an OLE object field or array data such
'as hierarchical recordsets

Else
'EXCEL 97 or earlier: Use GetRows then copy array to Excel

' Copy recordset to an array
recArray = rst.GetRows
'Note: GetRows returns a 0-based array where the first
'dimension contains fields and the second dimension
'contains records. We will transpose this array so that
'the first dimension contains records, allowing the
'data to appears properly when copied to Excel

' Determine number of records

recCount = UBound(recArray, 2) + 1 '+ 1 since 0-based array


' Check the array for contents that are not valid when
' copying the array to an Excel worksheet
For iCol = 0 To fldCount - 1
For iRow = 0 To recCount - 1
' Take care of Date fields
If IsDate(recArray(iCol, iRow)) Then
recArray(iCol, iRow) = Format(recArray(iCol, iRow))
' Take care of OLE object fields or array fields
ElseIf IsArray(recArray(iCol, iRow)) Then
recArray(iCol, iRow) = "Array Field"
End If
Next iRow 'next record
Next iCol 'next field

' Transpose and Copy the array to the worksheet,
' starting in cell A2
objSht.Cells(2, 1).Resize(recCount, fldCount).Value = _
TransposeDim(recArray)
End If

' Auto-fit the column widths and row heights
objXL.Selection.CurrentRegion.Columns.AutoFit
objXL.Selection.CurrentRegion.Rows.AutoFit

End With

'Save the Workbook and quit Excel
objWkb.Save
objXL.Quit

Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rst = Nothing
' Set db = Nothing


Clientname = UCase(Clientname)

Select Case Clientname
Case kName1
'log ExportObject in log file
Call LogIt("Text to log")
Call Klanten(kName2)
Case kName2
'log ExportObject in log file
Call LogIt("Text to Log")
Call Klanten(kName3)
Case kName3
'log ExportObject in log file
Call LogIt("Text to log")

End Function


Have fun with it.
Greeting to all
CodeMania