А я тут на досуге придумал еще вариантик:
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
Sub RstToXLS(strSQL As String, strBook As String)
'strSQL - текст запроса
'strBook - путь и имя книги (без расширения)
On Error GoTo ErrHand
Dim rst As Recordset
Set rst = CurrentDb.OpenRecordset(strSQL)
Dim xls As New Excel.Application, wb As Excel.Workbook
xls.Workbooks.Add
Set wb = xls.ActiveWorkbook
Dim i As Long, j As Integer, k As Integer
j = rst.Fields.Count
Do Until rst.EOF
i = i + 1
For k = 1 To j
Cells(i, k).Value = rst.Fields(k - 1 )
Next
rst.MoveNext
Loop
wb.SaveAs strBook & ".xls"
wb.Close
xls.Quit
ErrHand:
rst.Close
Set rst = Nothing
Set xls = Nothing
End Sub
