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), _  
'* если FieldsName=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")  
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  
 
 
Комментарии и пожелания приветствуются :)  
пример использования в файле