Сохранение набора записей в массив в VBA

#sql-server #excel #vba #recordset

#sql-сервер #excel #vba #набор записей

Вопрос:

У меня есть динамическая функция для вызова хранимой процедуры и сохранения набора записей в массиве, который я хочу использовать в другом подразделении. Но я не получаю результат в таком массиве:

 Array(0,0) = 1
Array(0,1) = Miller
Array(1,0) = 2
Array(1,1) = Jones
Array(2,0) = 3
Array(2,1) = Jackson
....
  

Мой результат массива выглядит следующим образом:

 Array(0,0) = 1
Array(1,0) = Miller
Array(0,1) = 2
Array(1,1) = Jones
Array(0,2) = 3
Array(1,2) = Jackson
....
  

Чтобы понять процесс, я показываю вам SQL-statement :

 CREATE PROCEDURE dbo.sp_GetAllPersons
AS
BEGIN
    SET NOCOUNT ON;

    SELECT DISTINCT u.ID, u.Name
    FROM dbo.v_Users u
END
GO
  

Функция для получения набора записей и сохранения его в массиве:

 Public Function fGetDataBySProc(ByVal sProcName As String) As Variant
    ...
    
    Dim Cmd As New ADODB.Command
    With Cmd
        .ActiveConnection = cn
        .CommandText = sProcName
        .CommandType = adCmdStoredProc
    End With
    
    Dim ObjRs As New ADODB.Recordset: Set ObjRs = Cmd.Execute
    Dim ArrData() As Variant
    
    If Not ObjRs.EOF Then
        ArrData = ObjRs.GetRows(ObjRs.RecordCount)
    End If
    
    ObjRs.Close
    cn.Close
    
    fGetDataBySProc = ArrData
End Function
  

Подраздел, в котором вызывается функция:

 Public Sub cbFillPersons()
    Dim sProcString As String: sProcString = "dbo.sp_GetAllPersons"
    Dim ArrData As Variant: ArrData = fGetDataBySProc(sProcString)   
    Dim i as Integer
    
    ' Just for testing
    For i = LBound(ArrData) To UBound(ArrData)
        Debug.Print "AddItem: " amp; ArrData(0, i)
        Debug.Print "List: " amp; ArrData(1, i)
    Next
End Sub
  

Я не знаю, что я делаю не так. Может быть, это .GetRows() -метод?

Комментарии:

1. не проще ли было бы просто выполнить запрос мощности в SQL db??? Использование VBA для этого — so 2003.

2. Вы не делаете ничего плохого как такового: именно так работает GetRows() . Он возвращает 2D-массив с размерами (от 1 до #ofColumns, от 1 до #ofRows). Вы все равно можете использовать этот массив.

Ответ №1:

Транспонирование 2D-массива

  • Вы можете транспонировать полученный массив с помощью getTransposedArray функции.

  • Тогда последняя строка в вашей fGetDataBySProc функции будет:

      fGetDataBySProc = getTransposedArray(ArrData) 
      

Функция

 Function getTransposedArray(Data As Variant) _
         As Variant
    
    Dim LB2 As Long
    LB2 = LBound(Data, 2)
    Dim UB2 As Long
    UB2 = UBound(Data, 2)
    
    Dim Result As Variant
    ReDim Result(LB2 To UB2, LBound(Data, 1) To UBound(Data, 1))
    
    Dim i As Long
    Dim j As Long
    
    For i = LBound(Data, 1) To UBound(Data, 1)
        For j = LB2 To UB2
            Result(j, i) = Data(i, j)
        Next j
    Next i
    
    getTransposedArray = Result
                 
End Function