ADO2VAR.BAS

Hàm Ado2Var lấy mảng từ câu lệnh ADO
Các hàm mảng tham khảo của Chip Pearson.
Hàm này dùng với addin Heo_ArrayFormular ngay trên bảng tính hoặc dùng trong VBA.

Nào mời các bạn test.

Function Ado2Var(StrSQL As String) As Variant
On Error GoTo ErrHander
Dim Cn As Object, Rs As Object
Set Cn = CreateObject("ADODB.Connection"): Set Rs = CreateObject("ADODB.Recordset")
With Cn
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Chr(39) & _
ThisWorkbook.FullName & Chr(39) _
& ";Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"
.Open
End With
Set Rs = Cn.Execute(StrSQL)
Ado2Var = TransposeArray(Rs.getRows)
Rs.Close: Cn.Close
Set Cn = Nothing: Set Rs = Nothing
ErrHander:
Set Cn = Nothing: Set Rs = Nothing
Exit Function
End Function

Function TransposeArray(InputArr As Variant) As Variant
Dim OutPutArr As Variant, RowNdx As Long, ColNdx As Long, LB1 As Long, LB2 As Long, UB1 As Long, UB2 As Long
If IsArray(InputArr) = False Then
Exit Function
End If
If NumberOfArrayDimensions(Arr:=InputArr) <> 2 Then
Exit Function
End If
LB1 = LBound(InputArr, 1): LB2 = LBound(InputArr, 2)
UB1 = UBound(InputArr, 1): UB2 = UBound(InputArr, 2)
ReDim OutPutArr(LB2 To LB2 + UB2 - LB2, LB1 To LB1 + UB1 - LB1)
For RowNdx = LBound(InputArr, 2) To UBound(InputArr, 2)
For ColNdx = LBound(InputArr, 1) To UBound(InputArr, 1)
OutPutArr(RowNdx, ColNdx) = InputArr(ColNdx, RowNdx)
Next ColNdx
Next RowNdx
TransposeArray = OutPutArr
End Function

Function NumberOfArrayDimensions(Arr As Variant) As Integer
Dim Ndx As Integer, Res As Integer
On Error Resume Next
Do
Ndx = Ndx + 1
Res = UBound(Arr, Ndx)
Loop Until Err.Number <> 0
NumberOfArrayDimensions = Ndx - 1
End Function

DuyTG tặng cho học viên VBA201. 02/2018