Menyimpan Recordset ke Array di VBA
Oct 18 2020
Saya memiliki fungsi dinamis untuk memanggil prosedur tersimpan dan menyimpan kumpulan data dalam array, yang ingin saya gunakan di sub lain. Tapi saya tidak mendapatkan hasil dalam array seperti ini:
Array(0,0) = 1
Array(0,1) = Miller
Array(1,0) = 2
Array(1,1) = Jones
Array(2,0) = 3
Array(2,1) = Jackson
....
Hasil Array saya seperti ini:
Array(0,0) = 1
Array(1,0) = Miller
Array(0,1) = 2
Array(1,1) = Jones
Array(0,2) = 3
Array(1,2) = Jackson
....
Untuk memahami prosesnya, saya menunjukkan kepada Anda 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
Fungsi untuk mendapatkan kumpulan data dan menyimpannya dalam sebuah array:
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
Sub tempat fungsi tersebut dipanggil:
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: " & ArrData(0, i)
Debug.Print "List: " & ArrData(1, i)
Next
End Sub
Saya tidak tahu, apa yang saya lakukan salah. Mungkin itu .GetRows()-metodenya?
Jawaban
2 VBasic2008 Oct 18 2020 at 22:27
Ubah urutan Array 2D
Anda dapat mengubah urutan array yang dihasilkan menggunakan
getTransposedArrayfungsi tersebut.Kemudian baris terakhir dalam
fGetDataBySProcfungsi Anda adalah:fGetDataBySProc = getTransposedArray(ArrData)
Fungsi
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
Selalu Menjadi Ancaman: Mengapa Orang Berkulit Coklat dan Hitam Tidak Bisa Nyaman di Amerika Serikat
Taylor Sheridan Baru Menambahkan 1 Bintang 'Yellowstone' Favoritnya ke Pemeran 'Lawmen: Bass Reeves'