Всем привет.
Захотелось мне сделать процедурку для вытягивания данных с базы путем вызова хранимой процедуры. Сама база MSSQL 2008 R2.
Все хорошо если процедура возвращает один набор данных, т.е. там вызывается только один сэлэкт. А мне вот нужно разобрать ответ с множественными сэлэктами.
Пример хранимой процедуры:
USE [TEST]
GO
SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
ALTER PROCEDURE [dbo].[PRC_TEST]
@arcdate date
AS
BEGIN
SET NOCOUNT ON;
SELECT top 10 my_row from TST_TABLE;
SELECT top 5 my_row from TST_TABLE;
END
Вот то, что у меня получилось, данные корректно вытягивает, но с ошибкой, ее можно подавить обработчиком, но мне интересна сама причина, на первый взгляд все по мануалу мелкософтовцев.
Private Sub GetStoredProcData(ByRef aCnn As ADODB.Connection, ByVal aSheetName As String, ByVal aProcname As String, aProcparams() As Variant)
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Application.Calculation = xlCalculateManual
Dim aCmd As ADODB.Command
Dim aRS As ADODB.Recordset
Dim i As Long, aRows As Long, itemCount As Long
Set aCmd = New ADODB.Command
Set aRS = New ADODB.Recordset
'подготовка команды
aCmd.ActiveConnection = aCnn
aCmd.CommandText = aProcname
aCmd.CommandType = adCmdStoredProc
aCmd.CommandTimeout = 0
aCmd.Parameters.Refresh
'разбор параметров из массива
For i = 1 To UBound(aProcparams, 1)
aCmd.Parameters(i).Value = aProcparams(i)
Next i
aRS.CursorLocation = adUseClient
aRS.Open aCmd, , adOpenStatic, adLockReadOnly
'Set aRS = aCmd.Execute() 'запуск процедуры
Sheets(aSheetName).Columns.ClearContents 'очистка листа
aRows = 0
itemCount = 0
'MsgBox CStr(itemCount) & " - " & CBool(IsEmpty(aRS))
Do While Not (aRS Is Nothing)
'MsgBox CBool(aRS.State = adStateClosed)
itemCount = itemCount + 1
If aRS.State <> adStateClosed Then
'копирование шапки
For i = 0 To aRS.Fields.Count - 1
Sheets(aSheetName).Cells(aRows + itemCount, i + 1).Value = aRS.Fields(i).Name
Next i
'копирование данных
Sheets(aSheetName).Range("A" & CInt(aRows + itemCount + 1)).CopyFromRecordset aRS
aRows = aRS.RecordCount
End If
Set aRS = aRS.NextRecordset
Loop
'закрытие набора данных
aRS.Close
Set aRS = Nothing
Set aCmd = Nothing
Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
' clean up
If Not aRS Is Nothing Then
If aRS.State = adStateOpen Then aRS.Close
End If
Set aRS = Nothing
If Err <> 0 Then
'If Err.Number <> 3704 Then 'Skip: Operation is not allowed then object closed.
MsgBox Err.Source & "--> Num:" & CStr(Err.Number) & " - " & Err.Description, , "Error"
'End If
End If
End Sub
В конце вылетает: Object variable or With block variable not set (номер ошибки: 91)
Предполагаю что-то не так при проверке статуса объекта, но он же Not aRS Is Nothing, как он может быть некорректен, когда присваивался методом Set aRS = aRS.NextRecordset. Что не делал, как не проверял, ошибка или 3704 (без проверки aRS.State <> adStateClosed) или 91 с ней.
Буду рад любой помощи.
