Форум программистов «Весельчак У»
  *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

  • Рекомендуем проверить настройки временной зоны в вашем профиле (страница "Внешний вид форума", пункт "Часовой пояс:").
  • У нас больше нет рассылок. Если вам приходят письма от наших бывших рассылок mail.ru и subscribe.ru, то знайте, что это не мы рассылаем.
   Начало  
Наши сайты
Помощь Поиск Календарь Почта Войти Регистрация  
 
Страниц: [1]   Вниз
  Печать  
Автор Тема: Работа с ADODB.Recordset (NextRecordset)  (Прочитано 2674 раз)
0 Пользователей и 1 Гость смотрят эту тему.
..::SCRIBE::..
Помогающий

ua
Offline Offline
Пол: Мужской
не путайте банальность с ленью=)


« : 01-03-2016 09:56 » 

Всем привет.

Захотелось мне сделать процедурку для вытягивания данных с базы путем вызова хранимой процедуры. Сама база MSSQL 2008 R2.
Все хорошо если процедура возвращает один набор данных, т.е. там вызывается только один сэлэкт. А мне вот нужно разобрать ответ с множественными сэлэктами.
Пример хранимой процедуры:
Код: (T-SQL)
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

Вот то, что у меня получилось, данные корректно вытягивает, но с ошибкой, ее можно подавить обработчиком, но мне интересна сама причина, на первый взгляд все по мануалу мелкософтовцев.

Код: (Visual Basic)
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 с ней.
Буду рад любой помощи.
Записан
..::SCRIBE::..
Помогающий

ua
Offline Offline
Пол: Мужской
не путайте банальность с ленью=)


« Ответ #1 : 01-03-2016 10:21 » 

Ошибка найдена, закрывал закрытый рекордсэт. Надо было просто убрать aRS.Close. Ну и еще недоработки с позиционированием данных, но это такое...
Записан
Страниц: [1]   Вверх
  Печать  
 

Powered by SMF 1.1.21 | SMF © 2015, Simple Machines