Как сохранить запрос в Книге Excel?

Option Compare Database
 
Function IsExcelLoad() As Boolean
On Error Resume Next
Dim ExcelApp As Object
Set ExcelApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Err.Clear
IsExcelLoad = False
Else
IsExcelLoad = True
Set ExcelApp = Nothing
End If
End Function
 
Function GetExcelObject() As Object
If IsExcelLoad Then
Set GetExcelObject = GetObject(, "Excel.Application")
Else
On Error Resume Next
Set GetExcelObject = CreateObject("Excel.Application")
If Err.Number <> 0 Then
Err.Clear
Set GetExcelObject = Nothing
Exit Function
End If
End If
End Function
 
Function NewWorkbook(ExcelApp As Object) As Object
ExcelApp.Workbooks.Add
Set NewWorkbook = ExcelApp.ActiveWorkbook
End Function
 
Sub ExportBDFile()
Dim ExcelApp As Object, ExcelWB As Object
Dim objRst As RecordSet
 
Set ExcelApp = GetExcelObject()
ExcelApp.Visible = True
Set ExcelWB = NewWorkbook(ExcelApp)
 
Set objRst = CurrentDb.OpenRecordset("new_workbook")
If objRst.RecordCount <> 0 Then
ExcelApp.Sheets(1).Range("A1").CopyFromRecordset objRst
End If
End Sub

Dim parusConn as ADODB.Connection
Dim parusRS as ADODB.Racordset
 
strConn ="Driver={Microsoft Excel Driver (*.xls)};" & _
          "DriverId=790;" & _
          "Dbq=" & твой_файл & ";" & _
          "DefaultDir=" & путь_к_файлу & ";"
Set parusConn = New ADODB.Connection
parusConn.Open strConn
Set parusRS = New ADODB.Recordset
parusRS.Open "SELECT * FROM [Лист1$]", parusConn, adOpenStatic, adLockReadOnly
parusRS.MoveLast
parusRS.MoveFirst