Public Function ADO_R_Dmitry(ByVal strSql$, ByVal FilePath$, ByVal OutputRange As Range, _
ByVal FieldsName As Boolean, ByVal OutputFieldsName As Boolean)

Dim sCon As String, FieldName As String
Dim rs As Object, cn  As Object

Set rs = CreateObject("ADODB.Recordset")
Set cn = CreateObject("ADODB.Connection")
If FieldsName Then FieldName = "Yes" Else FieldName = "No"
Select Case CLng(Split(Application.Version, ".")( 0 ))
    Case Is <  12 
        sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FilePath _
          & ";Extended Properties=""Excel 8.0;HDR=" & FieldName & ";IMEX=1"";"
    Case Is >=  12 
        sCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FilePath _
        & ";Extended Properties=""Excel 12.0;HDR=" & FieldName & ";IMEX=1"";"
End Select

cn.Open sCon
If Not cn.State =  1  Then Exit Function
Set rs = cn.Execute(strSql)
If Not FieldsName Then OutputFieldsName = False
 If OutputFieldsName Then
    For i =  0  To rs.Fields.Count -  1 
    OutputRange.Offset( 0 , i) = rs.Fields(i).Name
    Next
    Set OutputRange = OutputRange.Offset( 1 ,  0 )
 End If
OutputRange.CopyFromRecordset rs
rs.Close:  cn.Close
Set cn = Nothing: Set rs = Nothing
End Function

Sub Test()
'пример использования
strSql2 = "SELECT DISTINCTROW Max(F1), Last(F2), F3, F4, F5, F6, Last(F7), F8, Last(F9), Last(F10) , F11, F12, F13, F14, F15, Last(F16), Last(F17), Last(F18), Last(F19), Last(F20), Last(F21) , Last(F22)" _
& " FROM [Лист1$] GROUP BY F3, F4, F5, F6, F8, F11, F12, F13,F14, F15"
 Sheets( 2 ).[a1].CurrentRegion.ClearContents
Call ADO_R_Dmitry(strSql2, ThisWorkbook.FullName, Sheets( 2 ).[a1], False, False)
Sheets( 2 ).Activate
End Sub