VBA Error executing query with parameters

[pbassett]

I get this VBA error when I try to execute a query with 3 parameters
"-2147217887: Multiple-step OLE DB operation generated errors"
It runs fine from Access and I have run many queries in VBA without an issue. I don't believe I have previously seen this error so hopefully someone can help.
The parameters are:
.Parameters.Append .CreateParameter("param1", adVarWChar, adParamInput, adChar, i)
.Parameters.Append .CreateParameter("param2", adDate, adParamInput, adChar, Me.StartDate)
.Parameters.Append .CreateParameter("param3", adDate, adParamInput, adChar, Me.EndDate)
For the parameters, i starts as 1 and the form contains the StartDate and EndDate date fields.
The query does a Group By:

SELECT Main.Category
FROM Main
WHERE (((Main.Type)=[Type: 1=Safety; 2 = Maintenance]) AND
((Main.[End Date]) Between [Close Date - Start] And [Close Date - End]))
GROUP BY Main.Category;

 

[xenou]

You probably should post all the code.

 

[pbassett]

It breaks on the "Volume" code at "Set rs = .Execute" after running correctly on the "Aging Closed" code.
The Volume query SQL is

SELECT Main.Category AS Category, Count(Main.Category) AS [Count]
FROM Main
WHERE (((Main.Type)=[Type: 1=Safety; 2 = Maintenance]) AND ((Main.[End Date]) Is Null) AND ((Main.[Start Date]) Between [Start Date - Start] And [Start Date - End]))
GROUP BY Main.Category
HAVING (((Count(Main.Category))<>0));

Option Compare Database

Private Sub Run_Click()

Dim rs As Object, cn As Object, tmpCmd As New ADODB.Command
Dim iRow As Integer, i As Integer, j As Integer, fName As String, days As Integer
Dim Status As String, statusDate As String, lastDate As String, numActiveCategories As Integer

Set xlApp = CreateObject("Excel.Application")
Set xlwb = xlApp.Workbooks.Open(CurrentProject.Path & "\Admin" & "Management Report TEMPLATE.xlsx")
xlApp.Visible = True

Set cn = Application.CurrentProject.Connection
Set rs = CreateObject("ADODB.Recordset")

With tmpCmd
.ActiveConnection = cn
.CommandType = adCmdStoredProc
End With

xlwb.Sheets("Aging").Select
With tmpCmd
.CommandText = "qryAgingClosed"
For i = 1 To 2
.Parameters.Append .CreateParameter("param1", adVarWChar, adParamInput, adChar, i)
.Parameters.Append .CreateParameter("param2", adVarWChar, adParamInput, adChar, Me.Start_Date)
.Parameters.Append .CreateParameter("param2", adVarWChar, adParamInput, adChar, Me.End_Date)
Set rs = .Execute
xlwb.ActiveSheet.Range(IIf(i = 1, "A", "E") & 3).CopyFromRecordset rs
Call DeleteParameters(tmpCmd)
Next i
End With

xlwb.Sheets("Volume").Select
With tmpCmd
.CommandText = "qryVolume"
For i = 1 To 2
.Parameters.Append .CreateParameter("param1", adVarWChar, adParamInput, adChar, i)
.Parameters.Append .CreateParameter("param2", adVarWChar, adParamInput, adChar, Me.Start_Date)
.Parameters.Append .CreateParameter("param2", adVarWChar, adParamInput, adChar, Me.End_Date)
Set rs = .Execute
xlwb.ActiveSheet.Range(IIf(i = 1, "A", "E") & 3).CopyFromRecordset rs
Call DeleteParameters(tmpCmd)
Next i
End With

rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing

With xlwb
.ActiveSheet.Range("A2").Select
fName = "Management Report " & Format(Date, "yyyymmdd") & ".xlsx"
.SaveAs CurrentProject.Path & "\Reports" & fName
.Close
End With
Set xlwb = Nothing
xlApp.Quit
Set xlApp = Nothing

MsgBox fName & " was created."

End Sub

 

[pbassett]

Oops - the 2nd .CreateParameter statement for each query should of course be named "param3".

 

[xenou]

Is this run in Access or in Excel?
What is in the function DeleteParameters()?

Also just to be clear, the first parameter appears to be a number but you are declaring it as a character/string? Is that intentional? What is the required datatype?

Also your parameters aren't named consistently (code calls them "param1", "param2", etc. but the query seems to have defined them as [Type: 1=Safety; 2 = Maintenance], [End Date], etc. ... is that intentional? Why aren't you naming parameters with their actual names?

 

[pbassett]

It is written in Access VBA and I'm populating an Excel spreadsheet.
The subroutine DeleteParameters deletes the Command parameters so I can create them all over again in the next query.
For the first parameter based on your suggestion I replaced adChar with adInteger.
I have never had issues with naming parameters "param1", etc. but based on your suggestion I renamed them to match the query prompt. I figured that if it doesn't fail with param1 then if the next developer ever changes the query prompt it won't fail.
I still get the same results. The first query runs OK and it fails with -2147467259 (80004005) Invalid Operation at the qryVolume execute statement.

Option Compare Database

Private Sub Run_Click()

Dim rs As Object, cn As Object, tmpCmd As New ADODB.Command
Dim iRow As Integer, i As Integer, j As Integer, fName As String, days As Integer
Dim Status As String, statusDate As String, lastDate As String, numActiveCategories As Integer

Set xlApp = CreateObject("Excel.Application")
Set xlwb = xlApp.Workbooks.Open(CurrentProject.Path & "\Admin" & "Management Report TEMPLATE.xlsx")
xlApp.Visible = True

Set cn = CurrentProject.Connection
Set rs = CreateObject("ADODB.Recordset")

With tmpCmd
.ActiveConnection = cn
.CommandType = adCmdStoredProc
End With

xlwb.Sheets("Aging").Select
With tmpCmd
.CommandText = "qryAgingClosed"
For i = 1 To 2
.Parameters.Append .CreateParameter("[Type: 1=Safety; 2 = Maintenance]", adInteger, adParamInput, adChar, i)
.Parameters.Append .CreateParameter("[Close Date - Start]", adVarWChar, adParamInput, adChar, Me.Start_Date)
.Parameters.Append .CreateParameter("[Close Date - End]", adVarWChar, adParamInput, adChar, Me.End_Date)
Set rs = .Execute
xlwb.ActiveSheet.Range(IIf(i = 1, "A", "E") & 3).CopyFromRecordset rs
Call DeleteParameters(tmpCmd)
Next i
End With

xlwb.Sheets("Volume").Select
With tmpCmd
.CommandText = "qryVolume"
For i = 1 To 2
.Parameters.Append .CreateParameter("[Type: 1=Safety; 2 = Maintenance]", adInteger, adParamInput, adChar, i)
.Parameters.Append .CreateParameter("[Start Date - Start]", adVarWChar, adParamInput, adChar, Me.Start_Date)
.Parameters.Append .CreateParameter("[Start Date - End]", adVarWChar, adParamInput, adChar, Me.End_Date)
Set rs = .Execute
xlwb.ActiveSheet.Range(IIf(i = 1, "A", "E") & 3).CopyFromRecordset rs
Call DeleteParameters(tmpCmd)
Next i
End With

rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing

With xlwb
.ActiveSheet.Range("A2").Select
fName = "Management Report " & Format(Date, "yyyymmdd") & ".xlsx"
.SaveAs CurrentProject.Path & "\Reports" & fName
.Close
End With
Set xlwb = Nothing
xlApp.Quit
Set xlApp = Nothing

MsgBox fName & " was created."

End Sub

 

[xenou]

Have you stepped through the code?

Note that it's irrelevant but I would never select worksheets. You can just use the worksheet by name without selecting it:
xlwb.Sheets("Aging").Range(IIf(i = 1, "A", "E") & 3).CopyFromRecordset rs

Although having said that for purposes of testing you might actually make the workbook visible and check the results as you step through the code ... but in the final ("production") version of the code it shouldn't be necessary to have the workbook visible or to use .Select in the code. First things first though ... just step through the code and see where/when the error occurs.

 

[pbassett]

While testing, I like to validate the functionality, especially when I'm writing to various parts of a sheet.
I have stepped through the code and the error is at "Set rs = .Execute" on the 2nd query, which runs correctly directly in Access. The error is "-2147467259 (80004005) Invalid Operation" in the qryVolume section.
I have *never* had a query fail like this so I can't figure it out, especially when it runs from Access.

 

[xenou]

Is that on the first iteration or the second iteration?
Since the code is nearly (or exactly) identical when it works with both of these queries (qryAgingClosed and qryVolume), what is different in the two queries? I'm not questioning the strangeness of the error - I've never heard of it before. Just in terms of debugging you probably have to just try different things until you get something that works.

You can also use DAO since you are working in Access. That's another solution (my preference when working with recordsets and Access is to go with DAO and I think with parameters it's a little cleaner).

 

[pbassett]

The first query is more complex - it places each closed Inspection item into an Aging bucket, groups them and gives the count:

SELECT IIf(DateDiff("d",[Start Date],[End Date])<=1,"0-1 Days",IIf(DateDiff("d",[Start Date],[End Date]) Between 2 And 5,"2-5",IIf(DateDiff("d",[Start Date],[End Date]) Between 6 And 10,"6-10",IIf(DateDiff("d",[Start Date],[End Date]) Between 11 And 30,"11-30",IIf(DateDiff("d",[Start Date],[End Date])>=31,"31+"))))) AS Aging, Count([Aging]) AS [Count]
FROM Main
WHERE (((Main.Type)=[Type: 1=Safety; 2 = Maintenance]) AND ((Main.[End Date]) Between [Close Date - Start] And [Close Date - End]))
GROUP BY IIf(DateDiff("d",[Start Date],[End Date])<=1,"0-1 Days",IIf(DateDiff("d",[Start Date],[End Date]) Between 2 And 5,"2-5",IIf(DateDiff("d",[Start Date],[End Date]) Between 6 And 10,"6-10",IIf(DateDiff("d",[Start Date],[End Date]) Between 11 And 30,"11-30",IIf(DateDiff("d",[Start Date],[End Date])>=31,"31+")))));

The Volume query is trivial - no buckets, just Grouping the Category and getting the Count. I have done these dozens of times:

SELECT Main.Category AS Category, Count(Main.Category) AS [Count]
FROM Main
WHERE (((Main.Type)=[Type: 1=Safety; 2 = Maintenance]) AND ((Main.[End Date]) Is Null) AND ((Main.[Start Date]) Between [Start Date - Start] And [Start Date - End]))
GROUP BY Main.Category
HAVING (((Count(Main.Category))<>0));