The following assumes:
1) The data starts at A1:A3
2) a reference to Excel and DAO set
3) the excel workbook is in the same directory as the database application
4) the three "values" are in fields: Field1, Field2, Field3 (you didn't give
the field names)
Note: It will export as many *lines* as you have in the query.
Sub exportspreadsheet()
On Error GoTo HandleError
Dim objXLApp As Object
Set objXLApp = CreateObject("Excel.Application")
Dim objXLBook As Excel.Workbook
Dim objResultsSheet As Excel.Worksheet
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim RowVal As Integer
Dim ColVal As Integer
Set db = CurrentDb
Set rs = db.OpenRecordset("Data_for_report")
conPath = CurrentProject.Path
' open a workbook
Set objXLApp = Excel.Application
Set objXLBook = objXLApp.Workbooks.Open(conPath & "\reports.xls")
Set objResultsSheet = objXLBook.Worksheets("Data")
RowVal = 1
ColVal = 1
Do While Not objResultsSheet.Cells(RowVal, ColVal) = Empty
RowVal = RowVal + 1
Loop
Do While Not rs.EOF
objResultsSheet.Range(Cells(RowVal, ColVal), Cells(RowVal, ColVal))
= rs!Field1
objResultsSheet.Range(Cells(RowVal, ColVal + 1), Cells(RowVal,
ColVal + 1)) = rs!Field2
objResultsSheet.Range(Cells(RowVal, ColVal + 2), Cells(RowVal,
ColVal + 2)) = rs!Field3
RowVal = RowVal + 1
rs.MoveNext
Loop
objXLBook.Save
objXLBook.Close
MsgBox "Done!"
ProcDone:
On Error Resume Next
' Let's clean up our act
Set qdf = Nothing
Set db = Nothing
Set rs = Nothing
Set objResultsSheet = Nothing
Set objXLBook = Nothing
Set objXLApp = Nothing
ExitHere:
Exit Sub
HandleError:
MsgBox Err.Description, vbExclamation, _
"Error " & Err.Number
Resume ProcDone
End Sub
--
--Roger Carlson
MS Access MVP
Access Database Samples:
www.rogersaccesslibrary.com
Want answers to your Access questions in your Email?
Free subscription:
http://peach.ease.lsoft.com/scripts/wa.exe?SUBED1=ACCESS-L