Как в Excel добавить рекордсет?

Sub one()
Dim db As DAO.database
Dim rs As DAO.Recordset
Set db = DAO.OpenDatabase('C:your_base.mdb')
Set rs = db.OpenRecordset('SELECT fields1 FROM Table1 ORDER BY 1;')
Range('A1').CopyFromRecordset rs
End Sub

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim xl As Object
Dim i AS Long
Dim ii As String
 
Set db=DAO.Opendatabase (db_name)
Set xl = CreateObject('Excel.Application')
xl.workbooks.open ('Excel-workbook-full-path')
with xl.activeworkbook.activesheet
 
   set rs=db.openrecordset('SELECT id, f1,f2,f3 FROM Table1 ORDER BY ')
i=1
   do while not rs.eof
 
      ii=ltrim$(str$(i))
      .range('A'+ii)=rs.fields(0)
      .range('B'+ii)=rs.fields(1)
      .range('C'+ii)=rs.fields(2)
      .range('D'+ii)=rs.fields(3)
      i=i+2
      rs.movenext
   loop
end with
rs.close
set rs=nothing
set db=nothing
xl.activeworkbook.saveeas ('Excel-workbook-full-path')
set xl=nothing