ADO Recordset Not Staying Open in VBA - "Operation is not allowed when the object is closed"
I don't really understand what has happened here. I'm using Excel VBA to connect to a SQL Server Express database and return an ADO Recordset. I had it working initially, but my code was a bit messy so I created a new module and copied the code across, tidying it up as I went along.
Now, when I try to run the Sub just to return a the recordcount, I get the error "The operation is not allowed when the object is closed." The code breaks on the MsgBox line.
Here is the simplified code:
Dim Server As String
Server = "ServerName"
Dim Database As String
Database = "DatabaseName"
Dim UserID As String
UserID = "UserID"
Dim Pwd As String
Pwd = "Password"
Dim StoredProcedure As String
StoredProcedure = "StoredProcedureName"
Dim conn As New ADODB.Connection
conn.ConnectionString = "Driver={SQL Server};Server=" & Server & "; Database=" & Database & "; UID = " & UserID & "; PWD=" & Pwd & ""
conn.Open
Dim Cmd As New ADODB.Command
Cmd.ActiveConnection = conn
Cmd.CommandText = StoredProcedure
Cmd.CommandType = adCmdStoredProc
Dim params() As String
ReDim Preserve params(4, 2)
params(0, 0) = "Param1"
params(1, 0) = CStr(adInteger)
params(2, 0) = CStr(adParamInput)
params(4, 0) = CStr(6)
params(0, 1) = "Param2"
params(1, 1) = CStr(adInteger)
params(2, 1) = CStr(adParamInput)
params(4, 1) = CStr(6)
params(0, 2) = "Param3"
params(1, 2) = CStr(adInteger)
params(2, 2) = CStr(adParamInput)
params(4, 2) = CStr(15)
Dim sParam4 as String
If Not sParam4 = "" Then
ReDim Preserve params(4, UBound(params, 2) + 1)
params(0, UBound(params, 2)) = "Param4"
params(1, UBound(params, 2)) = CStr(adChar)
params(2, UBound(params, 2)) = CStr(adParamInput)
params(3, UBound(params, 2)) = "1"
params(4, UBound(params, 2)) = sParam4
End If
Dim sParam5 as String
If Not sParam5 = "" Then
ReDim Preserve params(4, UBound(params, 2) + 1)
params(0, UBound(params, 2)) = "Param5"
params(1, UBound(params, 2)) = CStr(adChar)
params(2, UBound(params, 2)) = CStr(adParamInput)
params(3, UBound(params, 2)) = Len(sParam5)
params(4, UBound(params, 2)) = sParam5
End If
Dim Prm As ADODB.Parameter
Set Prm = New ADODB.Parameter
Dim i As Integer
For i = 0 To UBound(params, 2)
If params(1, i) = CStr(adChar) Then
Set Prm = Cmd.CreateParameter(params(0, i), CInt(params(1, i)), CInt(params(2, i)), CInt(params(3, i)))
Cmd.Parameters.Append Prm
Cmd.Parameters(params(0, i)).Value = params(4, i)
Else
Set Prm = Cmd.CreateParameter(params(0, i), CInt(params(1, i)), CInt(params(2, i)))
Cmd.Parameters.Append Prm
Cmd.Parameters(params(0, i)).Value = CInt(params(4, i))
End If
Next i
Dim rs As New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open Cmd, , adOpenStatic, adLockOptimistic
MsgBox ("Success! " & rs.RecordCount & " Records Returned!")
When I look at the rs variable in the Locals window, all of the properties are listed as showing the same error message. To me, it seems as if the recordset is opening correctly, but then immediately closing itself.
What's weird is that the original (messy) sub now also doesn't work, throwing the same error. I don't think that I changed anything there, just copied it to the new sub.
I've commented out the entire module that the old sub was in, just in case there was any sort of conflicting variable situation going on. This didn't make any difference.
I just can't see what's wrong with it! I've done lots of research and reading, and to my untrained-but-enthusiastic eye, it all seems fine.
Any help would be much appreciated.
EDIT: Here is the Stored Procedure:
USE [MyDatabase]
GO
/****** Object: StoredProcedure [dbo].[MyProcedure] Script Date: 14/09/2015 11:39:00 ******/
SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
-- =============================================
-- Author: <Author,,Name>
-- Create date: <Create Date,,>
-- Description: <Description,,>
-- =============================================
ALTER PROCEDURE [dbo].[MyProcedure]
-- Add the parameters for the stored procedure here
@Param1 int, @Param2 int, @Param3 int, @Param4 char(1), @Param5 varchar(20) = NULL, @Param6 varchar(20) = NULL, @Param7 varchar(20) = NULL
AS
BEGIN
-- SET NOCOUNT ON added to prevent extra result sets from
-- interfering with SELECT statements.
SET NOCOUNT ON;
SET ANSI_WARNINGS OFF;
-- Insert statements for procedure here
DECLARE @cols AS NVARCHAR(MAX), @query AS NVARCHAR(MAX)
SET @cols = '';
SELECT @cols = @cols + ',' + QUOTENAME([Field3]) FROM View1
WHERE Field2 = @Param2 AND Field1 = @Param1
SET @cols = STUFF(@cols,1,1,'');
IF @Param5 IS NOT NULL
SET @query = 'SELECT Field1, Field2, Field3, Field4, Field5, Field6, Field7, Field8, Field9, Field10, Field11, Field12, Field13, Field14,' + @cols + ' FROM
(
SELECT
Table1.Field1,
Table1.Field2,
Table1.Field3,
Table1.Field4,
Table1.Field5,
Table1.Field6,
Table1.Field7,
Table1.Field8,
Table1.Field9,
Table1.Field10,
Table1.Field11,
Table1.Field12,
Table1.Field13,
Table1.Field14,
Table2.Field2,
Table3.Field1
FROM Table3
LEFT OUTER JOIN Table2 ON Table3.Field1 = Table2.Field1
AND Table3.Field2 = Table2.Field2
LEFT OUTER JOIN Table4 ON Table3.Field4 = Table4.Field1
AND Table3.Field2 = Table4.Field3
RIGHT OUTER JOIN Table1 ON Table2.Field1 = Table1.Field1
AND Table2.Field2 = Table1.Field15
WHERE Table1.Field2 = ' + CAST(@Param3 AS char(1)) + '
AND Table1.Field12 = ''' + @Param5 + '''
AND Table1.Field15 = ' + CAST(@Param1 AS char(2)) + '
)
AS UP
PIVOT(MAX(Field2) FOR UP.ID IN (' + @cols + ')) AS PVT '
ELSE IF @Param6 IS NOT NULL
SET @query = 'SELECT Field1, Field2, Field3, Field4, Field5, Field6, Field7, Field8, Field9, Field10, Field11, Field12, Field13, Field14,' + @cols + ' FROM
(
SELECT
Table1.Field1,
Table1.Field2,
Table1.Field3,
Table1.Field4,
Table1.Field5,
Table1.Field6,
Table1.Field7,
Table1.Field8,
Table1.Field9,
Table1.Field10,
Table1.Field11,
Table1.Field12,
Table1.Field13,
Table1.Field14,
Table2.Field2,
Table3.Field1
FROM Table3
LEFT OUTER JOIN Table2 ON Table3.Field1 = Table2.Field1
AND Table3.Field2 = Table2.Field2
LEFT OUTER JOIN Table4 ON Table3.Field4 = Table4.Field1
AND Table3.Field2 = Table4.Field3
RIGHT OUTER JOIN Table1 ON Table2.Field1 = Table1.Field1
AND Table2.Field2 = Table1.Field15
WHERE Table1.Field2 = ' + CAST(@Param3 AS char(1)) + '
AND Table1.Field13 = ''' + @Param6 + '''
AND Table1.Field15 = ' + CAST(@Param1 AS char(2)) + '
)
AS UP
PIVOT(MAX(Field2) FOR UP.ID IN (' + @cols + ')) AS PVT '
ELSE IF @Param7 IS NOT NULL
SET @query = 'SELECT Field1, Field2, Field3, Field4, Field5, Field6, Field7, Field8, Field9, Field10, Field11, Field12, Field13, Field14,' + @cols + ' FROM
(
SELECT
Table1.Field1,
Table1.Field2,
Table1.Field3,
Table1.Field4,
Table1.Field5,
Table1.Field6,
Table1.Field7,
Table1.Field8,
Table1.Field9,
Table1.Field10,
Table1.Field11,
Table1.Field12,
Table1.Field13,
Table1.Field14,
Table2.Field2,
Table3.Field1
FROM Table3
LEFT OUTER JOIN Table2 ON Table3.Field1 = Table2.Field1
AND Table3.Field2 = Table2.Field2
LEFT OUTER JOIN Table4 ON Table3.Field4 = Table4.Field1
AND Table3.Field2 = Table4.Field3
RIGHT OUTER JOIN Table1 ON Table2.Field1 = Table1.Field1
AND Table2.Field2 = Table1.Field15
WHERE Table1.Field2 = ' + CAST(@Param3 AS char(1)) + '
AND Table1.Field14 = ''' + @Param7 + '''
AND Table1.Field15 = ' + CAST(@Param1 AS char(2)) + '
) AS UP
PIVOT(MAX(Field2) FOR UP.ID IN (' + @cols + ')) AS PVT '
ELSE
SET @query = 'SELECT Field1, Field2, Field3, Field4, Field5, Field6, Field7, Field8, Field9, Field10, Field11, Field12, Field13, Field14,' + @cols + ' FROM
(
SELECT
Table1.Field1,
Table1.Field2,
Table1.Field3,
Table1.Field4,
Table1.Field5,
Table1.Field6,
Table1.Field7,
Table1.Field8,
Table1.Field9,
Table1.Field10,
Table1.Field11,
Table1.Field12,
Table1.Field13,
Table1.Field14,
Table2.Field2,
Table3.Field1
FROM Table3
LEFT OUTER JOIN Table2 ON Table3.Field1 = Table2.Field1
AND Table3.Field2 = Table2.Field2
LEFT OUTER JOIN Table4 ON Table3.Field4 = Table4.Field1
AND Table3.Field2 = Table4.Field3
RIGHT OUTER JOIN Table1 ON Table2.Field1 = Table1.Field1
AND Table2.Field2 = Table1.Field15
WHERE Table1.Field2 = ' + CAST(@Param3 AS char(1)) + '
AND Table1.Field3 = ''' + @Param4 + '''
AND Table1.Field15 = ' + CAST(@Param1 AS char(2)) + '
) AS UP
PIVOT(MAX(Field2) FOR UP.ID IN (' + @cols + ')) AS PVT '
EXECUTE (@query)
Set NOCOUNT OFF;
END
I know that the logic behind the parameters isn't very... logical.. but it works the way I need it to for now. It is something I'll change as I'm working on it.
I should also say that I omitted the section of my VBA code that handles the parameters for the SP when I first posted the question. I'm just leaving work now, but I'll add it in once I get home. I don't think the problem lies there though. I basically work through a string array of the parameters and append them to the Cmd object.
EDIT: I've now added the code for creating the parameters and passing them to the Cmd object. Again, it's a bit convoluted, but it's what came out of my head at the time and it does work. I'll revisit the logic once the recordset is populated.
Answer
This is a bit long for a comment so I'll put it here as a possible answer. Please try:
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
With rs
Set .ActiveConnection = conn
.LockType = adLockOptimistic
.CursorLocation = adUseServer
.CursorType = adOpenForwardOnly
.Open "SET NOCOUNT ON"
End With
rs.Open Cmd, , , , adCmdStoredProc
MsgBox ("Success! " & rs.RecordCount & " Records Returned!")