Public Sub GetWorksheetData(ByVal strSourceFile As String, ByVal strSQL As String, ByRef Massiv() As Variant, ByRef MassivHead() As Variant)
Dim cn As ADODB.Connection
Dim rstTemp As ADODB.Recordset

Set cn = New ADODB.Connection
cn.Open "DRIVER={Microsoft Excel Driver (*.xls)};DriverId=790;ReadOnly=True;" & "DBQ=" & strSourceFile & ";"
Set rstTemp = New ADODB.Recordset

rstTemp.Open strSQL, cn, adOpenForwardOnly, adLockReadOnly, adCmdText

Erase Massiv
Erase MassivHead
    x =  0 
        With rstTemp
        Do While Not .EOF
                    .MoveNext
                      x = x +  1 
            Loop
    End With

ReDim Massiv( 1  To x,  1  To rstTemp.Fields.Count) As Variant
ReDim MassivHead( 1  To  2 ,  1  To rstTemp.Fields.Count) As Variant

rstTemp.MoveFirst
            ' создание шапки
                For i =  0  To rstTemp.Fields.Count -  1 
                MassivHead( 1 , i +  1 ) = rstTemp.Fields(i).Name
                MassivHead( 2 , i +  1 ) = rstTemp.Fields(i).Type
                Next i
            ' создание массива данных
            
            For J =  0  To x -  1 
                For i =  0  To rstTemp.Fields.Count -  1 
                Massiv(J +  1 , i +  1 ) = rstTemp.Fields(i)
                Next i
            rstTemp.MoveNext
            Next J

rstTemp.Close
cn.Close

Set rstTemp = Nothing
Set cn = Nothing

End Sub