Excel VBA not passing parameters to ADO command object causing SP execute to error out 1

[jrbarnett]

All,

I am slowly going out of my mind on what should be something very simple that I have done many times before. I have a function in Excel VBA (2007 SP3) that submits data to a SQL Server database, connecting via ADO 2.8 and running a stored procedure on SQL Server 2008 Developer SP3.

I can run the stored proc via Management Studio, and it works fine. I have double and triple checked the parameters to make sure I haven't forgotten anything, have got the data types correct.
SQL Profiler shows the connection open from Excel, but the call to the stored procedure didn't pass across the parameters - ie it was just calling "usp_save_research_proposal"

The For Each loop over parameters shows them all present with correct values.

Relevant VBA code segments is as follows:

Public Function Save()

    ' JB new save function

    Dim cn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rst As ADODB.Recordset
    
    Dim prm As ADODB.Parameter ' for testing
    
    Dim intCount As Integer
    
    ' initialise ADO
    Set cn = New ADODB.Connection
    cn.Open DB_CONNECT
    
    On Error GoTo Err_SaveProposal

    Set cmd = New ADODB.Command
    With cmd
        .ActiveConnection = cn
        .CommandText = "usp_save_research_proposal"
        .NamedParameters = True
        .Parameters.Refresh
        .Parameters.Append .CreateParameter("@ProposalNo", adVarChar, adParamInput, 10, "3500")
        .Parameters.Append .CreateParameter("@Userid", adVarChar, adParamInput, 8, "username")
        .Parameters.Append .CreateParameter("@Funder", adVarChar, adParamInput, 50, "xxxx")
        .Parameters.Append .CreateParameter("@InvoiceParty", adVarChar, adParamInput, 50, "xxxx")
        .Parameters.Append .CreateParameter("@NewProposal", adVarChar, adParamInput, 4, "xxxx")
        .Parameters.Append .CreateParameter("@AccountCode", adVarChar, adParamInput, 8, "xxxx")
        .Parameters.Append .CreateParameter("@Title", adVarChar, adParamInput, 500, "xxxx")
        .Parameters.Append .CreateParameter("@Discipline", adVarChar, adParamInput, 5, "xxxx")
        .Parameters.Append .CreateParameter("@Region", adVarChar, adParamInput, 5, "xxx") 
        .Parameters.Append .CreateParameter("@PI_Surname", adVarChar, adParamInput, 50, "xxxx")
        .Parameters.Append .CreateParameter("@PI_Forename", adVarChar, adParamInput, 50, "xxxx")
        .Parameters.Append .CreateParameter("@PI_Title", adVarChar, adParamInput, 10, "xxxx")
        .Parameters.Append .CreateParameter("@PI_Dept", adVarChar, adParamInput, 4, "xxxx")
        .Parameters.Append .CreateParameter("@LabUse", adVarChar, adParamInput, 4, "-1")
        .Parameters.Append .CreateParameter("@GMUse", adVarChar, adParamInput, 4, "-1")
        .Parameters.Append .CreateParameter("@RadioUse", adVarChar, adParamInput, 4, "-1")
        .Parameters.Append .CreateParameter("@Cat3Use", adVarChar, adParamInput, 4, "-1")
        .Parameters.Append .CreateParameter("@BSFUse", adVarChar, adParamInput, 4, "-1")
        .Parameters.Append .CreateParameter("@LabOSUse", adVarChar, adParamInput, 4, "0")
        .Parameters.Append .CreateParameter("@RCT", adVarChar, adParamInput, 4, "0")
        .Parameters.Append .CreateParameter("@Meds", adVarChar, adParamInput, 4, "-1")
        .Parameters.Append .CreateParameter("@Tissue", adVarChar, adParamInput, 4, "-1")
        .Parameters.Append .CreateParameter("@OtherInt", adVarChar, adParamInput, 4, "-1")
        .Parameters.Append .CreateParameter("@EthApp", adVarChar, adParamInput, 4, "-1")
        .Parameters.Append .CreateParameter("@PPI", adVarChar, adParamInput, 4, "-1")
        .Parameters.Append .CreateParameter("@Sponsor", adVarChar, adParamInput, 4, "-1")
        .Parameters.Append .CreateParameter("@HighRisk", adVarChar, adParamInput, 4, "0")
        .Parameters.Append .CreateParameter("@StaffOS", adVarChar, adParamInput, 4, "-1")
   End With
    
    ' Debug code to ensure parameters are set correctly
    For Each prm In cmd.Parameters
        Debug.Print prm.Name & " : " & prm.Value
    Next
    
    cmd.Execute

    
Exit_SaveProposal:
    If cn.State = adStateOpen Then cn.Close
    Exit Function

Err_SaveProposal:
    MsgBox "Error submitting proposal: " & Err.Description & "(" & Err.Number & ")." & vbCrLf _
            & "Please contact MIS", vbOKOnly + vbInformation
    Resume Exit_SaveProposal

End Function

If it is any use, stored proc code is as follows:

ALTER PROCEDURE [dbo].[usp_save_research_proposal] 

	@ProposalNo varchar(10),
	@UserID varchar (8),
	@Funder varchar(50),
	@InvoiceParty varchar (50),
	@NewProposal varchar(4),
	@AccountCode varchar(8),
	@Title varchar(500),
	@Discipline varchar(5),
	@Region varchar(5),
	@PI_Surname varchar(50),
	@PI_Forename varchar(50),
	@PI_Title varchar(10),
	@PI_Dept varchar(4),
	@LabUse varchar(4),
	@GMUse varchar(4),
	@RadioUse varchar(4),
	@Cat3Use varchar(4),
	@BSFUse varchar(4),
	@LabOSUse varchar(4),
	@RCT varchar(4),
	@Meds varchar(4),
	@Tissue varchar(4),
	@OtherInt varchar(4),
	@EthApp varchar(4),
	@PPI varchar(4),
	@Sponsor varchar(4),
	@HighRisk varchar(4),
	@StaffOS varchar(4)

AS

	set nocount on
	
	DECLARE @InsertDate Datetime
	Set @InsertDate = (Select GetDate())

	BEGIN TRY
	-- Delete record if it already exists - complete overwrite of existing records
		IF EXISTS (select 1 FROM proposals WHERE Proposal_ID= @ProposalNo)
			BEGIN
-- This selection will output to Results pane if sp is run from Management Studio
			Select @ProposalNo 'Record Delete'

			DELETE Proposals where Proposal_Id = @ProposalNo
			DELETE Proposal_Attributes where Proposal_Id = @ProposalNo
		END
	-- Now insert the record being saved (either new or replace)
	-- This selection will output to Results pane if sp is run from Management Studio

	--Select @ProposalNo 'Record Insert/Replace'

	INSERT INTO Proposals
			(Proposal_ID, UserID,
			Funder, InvoiceParty,
			New_Proposal, Account_Code,
			Title,
			Discipline, CountryFocus,
			NS_PI_Surname, NS_PI_Forename, NS_PI_Title, NS_PI_Dept,
			Lab_Use, GM_Use, Radio_Use, Cat3_Use,
			BSF_Use, LabOS_Use, RCT, Meds, Tissue, OtherInt,
			EthApp, PPI, Sponsor, HighRisk, StaffOS,
			[Status], Updated)

	VALUES	(@ProposalNo, @UserID,
				RTrim(LTrim(@Funder)), RTrim(LTrim(@InvoiceParty)),
				@NewProposal, LTrim(@AccountCode),
				RTrim(LTrim(@Title)),
				@Discipline, @Region,
				RTrim(LTrim(@PI_Surname)), RTrim(LTrim(@PI_Forename)),
				RTrim(LTrim(@PI_Title)), @PI_Dept,
				@LabUse, @GMUse, @RadioUse, @Cat3Use,
				@BSFUse, @LabOSUse, @RCT, @Meds, @Tissue, @OtherInt,
				@EthApp, @PPI, @Sponsor, @HighRisk, @StaffOS,
				0, @InsertDate)
END TRY
BEGIN CATCH
	SELECT @@ERROR
END CATCH

Does anybody have any ideas what I am doing wrong or how to fix this?
I know the insert stored proc still has some legacy code in it that needs tidying up but

 

[vbajock]

I usually use

.CommandType = adCmdStoredProc

after

.CommandText = "usp_save_research_proposal"

I don't know if that will make a difference, it might default to that.

Here is a link showing an alternative to Parameters.Refresh, you might want to try it:

http://www.devx.com/tips/Tip/13400

 

[jrbarnett]

Thank you, by putting the cmd.CommandType = adCmdStoredProc line in I now get "Procedure or function has too many arguments specified". Any ideas?

John

 

[jrbarnett]

Don't worry, now fixed. Typo on my part. Now to put actual rather than test data in there.

John