Exporting to Excel - adding information

[jtfalk]

Hi, I am trying to take a query (only 3 values and transfer them into an
excel worksheet. I want to open the workbook, write to the worksheet on the
next row available and put the 3 values. The excel file name is reports.xls,
worksheet is Data, and the Query is Data_for_report. I then want the Excel
file to close. Any help would be appreciated.

 

[Roger Carlson]

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

 

[Roger Carlson]

By the way, on my website (www.rogersaccesslibrary.com), is a small Access
database sample called "AppendValuesToExcel.mdb " which illustrates how to
do this. You can download it for free here:
http://www.rogersaccesslibrary.com/forum/forum_posts.asp?TID=522

--
--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