'===================================================================================================

'##### массив через ADO

'Sub test_Fn_ArrInConnectADO()

'    strDataFullName = "D:\Public\Documents\Temp\data_ref.accdb"

'    strSQL = "SELECT Expend.* FROM Expend;"

'    Arr = Fn_ArrInConnectADO(strDataFullName, strSQL)

'End Sub

'--------------------------------------------------------------------------------------------------

Function Fn_ArrInConnectADO(ByVal strDataFullName As String, _

                            ByVal strSQL As String) As Variant

Dim strAppVersion As String

Dim connDB As New ADODB.Connection

Dim rst As New ADODB.Recordset

    'On Error Resume Next

    strAppVersion = Application.Version

    Select Case strAppVersion

        Case "12.0"

            strConnect = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source" & _

                            strDataFullName & _

                            "; Jet OLEDB:Database;"

        Case "15.0"

            strConnect = "Provider=Microsoft.ACE.OLEDB.15.0;Data Source=" & _

                            strDataFullName & _

                            ";Persist Security Info=False;Password="""";User ID=Admin"

        Case "16.0"

            strConnect = "Provider=Microsoft.ACE.OLEDB.16.0;Data Source=" & _

                            strDataFullName & _

                            ";Persist Security Info=False;Password="""";User ID=Admin"

        Case Else

    End Select

    Set connDB = CreateObject("ADODB.Connection")

    connDB.Open ConnectionString:=strConnect

    rst.Open strSQL, connDB

    If Not rst.EOF Then

        ' Заполняем массив данными из рекордсета:

        Fn_ArrInConnectADO = rst.GetRows

        'Dim h As Long, v As Long

        'h = UBound(Fn_ArrInConnectADO, 1) ' Определяем сколько колонок*

        'v = UBound(Fn_ArrInConnectADO, 2) ' Определяем сколько строк*

    Else

        ' Если нет данных то вывод сообщения:

        MsgBox "Нет данных в таблице", vbInformation + vbOKOnly, "Ошибка"

    End If

    rst.Close

    connDB.Close

' Вставим наш массив на Лист1

' Worksheets("Лист1").Range(Cells(1, 1), Cells(v + 1, h + 1)) = Application.Transpose(arr)

End Function

'===================================================================================================