'----------------------------------------------------------------------------------------------------------------------------
'Данная функция читает в массив содержимое запроса или таблицы в некой access базе
'размерность массива не имеет значения, функция удаляет массив и переобъявляет размерность в соответствии с размером базы
'Массив 2х мерный даже если размер второго измерения 1, начало массива 1(а не 0, как по умолчанию).
'Для использования функции должен быть объявлен массив куда писать, 2ая переменная типа текст - путь к базе,
'3я переменная название запроса
' в случае успешного выполнения функция принимает значение TRUE
'----------------------------------------------------------------------------------------------------------------------------
Public Function ReadInArray(ByRef InArr() As Variant, ByVal paTH, QueryName As String) As Boolean
Dim X As Long
Dim db As DAO.Database
Dim rs As DAO.Recordset
ReadInArray = False
On Error GoTo endt
'открываем рекордсет и базу данных
Set db = DAO.OpenDatabase(paTH, , yes)
Set rs = db.OpenRecordset(QueryName)
' стираем массив для записи запроса
Erase InArr
'считаем размер массива
' rs.RecordCount не работает для запросов, тольк для таблиц
'X = 0
'Do While Not rs.EOF
'X = X + 1
'rs.MoveNext
'Loop
' переобъявляем массив
ReDim InArr( 1  To rs.RecordCount,  1  To rs.Fields.Count) As Variant
' записываем массив
'rs.MoveFirst
X =  0 
Do While Not rs.EOF
X = X +  1 
    For I =  0  To rs.Fields.Count -  1 
     InArr(X, I +  1 ) = rs.Fields(I)
    Next I
rs.MoveNext
Loop
ReadInArray = True
'Закрываем рекордсет и базу данных
rs.Close
db.Close
'Освобождаем память
Set rs = Nothing
Set db = Nothing

endt:
End Function

ReDim InArr( 1  To rs.RecordCount,  1  To rs.Fields.Count) As Variant

ReDim InArr( 1  To X,  1  To rs.Fields.Count) As Variant