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

'##### массив из таблицы базы данных через ADO

Sub test_Fn_ArrInConnectADO()

strDataFullName = "путь.accdb"

strTblName = "ListPJI_Block(username)"

strSQL = "SELECT [" & strTblName & "].* FROM [" & strTblName & "];"

Arr = Fn_ArrInConnectADO(strDataFullName, strSQL)

End Sub

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

Function Fn_ArrInConnectADO(ByVal strDataFullName As String, _

ByVal strSQL As String) As Variant

Dim connDB As New ADODB.Connection

Dim rst As New ADODB.Recordset

Dim strAppVersion As String

'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

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