Public Function ADO_R_Dmitry(ByVal StrSql$, ByVal FilePath$, ByVal OutputRange As Range, _
ByVal FieldsName As Boolean, ByVal OutputFieldsName As Boolean)
'==============================================================================
'*Описание функции : Возвращает набор записей Recordset с первой ячейки адреса,
'* указанного диапазона.
'*strSql - Конструкция SQL  запроса.
'* FilePath - Полный путь к файлу включая имя и расширение.
'* OutputRange - адрес ячеки с которой начинается вывод данных.
'* FieldsName - используются или нет заголовки столбцов (True - False)
'* OutputFieldsName - вывод данных с заголовками или без (True - False), _
'==============================================================================
'* Автор R Dmitry (Дмитрий Русак dg_rusak@mail.ru skype: RDG_Dmitry)          |
'* WM:_R269866874234 U144446690328                                            |
'==============================================================================
Dim sCon As String, FieldName As String
Dim rs As Object, cn  As Object
Set rs = CreateObject("ADODB.Recordset")
Set cn = CreateObject("ADODB.Connection")
Select Case Val(Application.Version)
    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
 DoEvents
OutputRange.CopyFromRecordset rs
rs.Close:  cn.Close
Set cn = Nothing: Set rs = Nothing
End Function

'=================Пример использования=======================
Sub test()
Dim strSql2$
strSql2 = "select * from table"
Sheets(2).[a1].CurrentRegion.ClearContents
Call ADO_R_Dmitry(strSql2, ThisWorkbook.FullName, Sheets(2).[a1], True, True)
Sheets(2).Activate
End Sub

If FieldsName Then FieldName = "Yes" Else FieldName = "No"

SqlReport = "SELECT First(Sad.NameSad), Sum(Q.DetiAll) AS DetiAll, Sum(Q.DetiV) AS DetiV, Sum(Q.Famall) AS FamAll, Sum(Q.FamOut) AS FamOut" _
& " FROM (SELECT first(Deti.[IdSad]) AS IDsad, count( Deti.[IdDeti]) AS DetiAll, 0 as DetiV, 0 as FamAll, 0 as FamOut" _
& " FROM Deti WHERE (Deti.[DataDeti] < " & DataSql(DF) & ") And (Deti.[DataVybDeti] >= " & DataSql(DS) & " Or Deti.[DataVybDeti] Is Null)" _
& " GROUP BY Deti.[IdSad] Union SELECT (Deti.IdSad) AS IDsad, 0 as DetiAll, Count((Deti.IdDeti)) AS DetiV, 0 as FamAll, 0 as FamOut" _
& " FROM Deti WHERE (((Deti.DataDeti) < " & DataSql(DF) & ") And ((Deti.DataVybDeti) >= " & DataSql(DS) & " And (Deti.DataVybDeti) < " & DataSql(DF) & "))" _
& " Group BY(Deti.idSad) Union SELECT First(A.IdSad) AS IDsad,  0 as DetiAll, 0 as DetiV, Count(A.DetiAll) AS FamiliAll , 0 as FamOut" _
& " FROM (SELECT First(Deti.IdSad) AS IDsad, Count(Deti.IdDeti) AS DetiAll" _
& " FROM Deti WHERE (((Deti.DataDeti) < " & DataSql(DF) & ") And ((Deti.DataVybDeti) >= " & DataSql(DS) & " Or (Deti.DataVybDeti) Is Null))" _
& " GROUP BY Deti.IdSad, Deti.IdFamili)  AS A" _
& " GROUP BY A.IdSad Union all SELECT A4.IDsad, 0 AS DetiAll, 0 as DetiV, 0 as FamAll, 1 AS FamOut" _
& " FROM (SELECT First(Deti.IdSad) AS IDsad, Count(Deti.IdDeti) AS DetiAll, Deti.IdFamili" _
& " FROM Deti WHERE (((Deti.DataDeti) < " & DataSql(DF) & ") And ((Deti.DataVybDeti) >= " & DataSql(DS) & " Or (Deti.DataVybDeti) Is Null))" _
& " GROUP BY Deti.IdFamili, Deti.IdSad) as A4 INNER Join" _
& " (SELECT First(Deti.IdSad) AS IDsad, Count(Deti.IdDeti) AS DetiAll, Deti.IdFamili" _
& " FROM Deti WHERE (((Deti.DataDeti) < " & DataSql(DF) & ") And ((Deti.DataVybDeti) >= " & DataSql(DS) & "And (Deti.DataVybDeti) < " & DataSql(DF) & "))" _
& " GROUP BY Deti.IdFamili, Deti.IdSad) as A44" _
& " ON (A4.IdFamili = A44.IdFamili) AND (A4.DetiAll = A44.DetiAll) AND (A4.IDsad = A44.IDsad))  AS Q INNER JOIN Sad ON Q.IDsad = Sad.IdSad" _
& " GROUP BY Q.IdSad"