Is there a way to append data to Excel file?

  • Thread starter Thread starter Ron Berns
  • Start date Start date
R

Ron Berns

I have a query that I would like to append to a spreadsheet.
I am using Access 2003 and Excel 2003.
The query is named Invoices.
The spreadsheet is named Deductions.
There are 12 Sheets within the spreadsheet.
The sheets are named PER 1, PER 2, PER 3, ... Per 12.
I would like to select the Sheet, in the Spreadsheet, and append the information from the Query.

Is this possible? How would I go about doing this?

Thanks in advance.

Ron
 
This may work too:
http://www.rondebruin.nl/copy1.htm

Use that in conjunction with this code...
It is quite easy to perform operations in Excel, and control the entire
process from Access. Make sure you set a reference to Excel, and then run
this code in an Access module:



Option Compare Database


Option Explicit ' Use this to make sure your variables are defined


' One way to be able to use these objects throughout the Module is to
Declare them here, and not in a Sub


Private objExcel As Excel.Application
Private xlWB As Excel.Workbook
Private xlWS As Excel.Worksheet



Sub Rep()


Dim strFile As String


strFile = "C:\Ryan\Crosstab_Query.xls" 'this is just an example, of course


‘Of course, this is just an example; put the actual path to your actual file
here…
' Opens Excel and makes it Visible


Set objExcel = New Excel.Application


objExcel.Visible = True


' Opens up a Workbook


Set xlWB = objExcel.Workbooks.Open(strFile)





' Sets the Workseet to the last active sheet - Better to use the commented
version and use the name of the sheet.


Set xlWS = xlWB.ActiveSheet


' Set xlWS = xlWB("Sheet1")



With xlWS ' You are now working with the Named file and the named worksheet
' Your Excel code begins here…you can even record a macro and make the
process super easy!!


End With


' Close and Cleanup


xlWB.SaveAs xlSaveFile
xlWB.Close


xlapp.Quit
Set xlapp = Nothing


End Sub


HTH,
Ryan---
 
Ron:

You can achieve your objective programmatically using DAO or ADO.
You could create a custom toolbar button in the Access
user-interface to run the program.

It seems unlikely that you'd want to export exactly the same
records 12 times to the 12 different sheets. I'm guessing that
you wish to amend the query so that it selects different records
for each worksheet.

The following code sample doesn't amend the query, but if you
need help getting it to do that post back with an explanation of
the criteria you wish to use.


Copy and paste the following code into a new blank module:

' CODE BEGINS:

Option Compare Database
Option Explicit

Public Sub ExportToExcel()

' Declare constant storing path\name of
' Excel Workbook:
Const mstrcPathToWorkbook As String = _
"C:\Deductions.xls"

' Declare constant storing name of query:
Const mstrcQueryName As String = "Invoices"

' Declare DAO object variables:
Dim mobjDB As DAO.Database
Dim mobjQDF As DAO.QueryDef
Dim mobjRS As DAO.Recordset

' Declare Excel object variables:
Dim mobjXL As Excel.Application
Dim mobjWB As Excel.Workbook
Dim mobjWS As Excel.Worksheet
Dim mobjRNG As Excel.Range

' Declare working variables:
Dim vbRetVal As VbMsgBoxResult
Dim avntWSName() As Variant
Dim strQDFName As String
Dim I As Integer
Dim lngWS As Long
Dim lngWSAdd As Long


On Error GoTo Error_ExportToExcel

' Ask if OK to proceed:
vbRetVal = MsgBox("OK to export to Excel?", _
vbQuestion + vbYesNoCancel, "Question")
If vbRetVal <> vbYes Then
MsgBox "Aborted export to Excel.", _
vbOKOnly + vbInformation, "Information"
GoTo Exit_ExportToExcel
End If

' Store Worksheet Names in an array:
avntWSName = Array("PER 1", "PER 2", "PER 3", _
"PER 4", "PER 5", "PER 6", "PER 7", "PER 8", _
"PER 9", "PER 10", "PER 11", "PER 12")

' Store a reference to this database:
Set mobjDB = CurrentDb()

' Open a DAO Recordset on the query:
Set mobjRS = mobjDB.OpenRecordset(mstrcQueryName)

' Start Excel and open the Workbook (named
' in the constant):
Set mobjXL = New Excel.Application
mobjXL.Visible = True
Set mobjWB = mobjXL.Workbooks.Open(mstrcPathToWorkbook)

' Export Invoice query to each Worksheet:
For I = LBound(avntWSName) To UBound(avntWSName)
Set mobjWS = mobjWB.Worksheets(avntWSName(I))
Set mobjRNG = mobjWS.Cells
With mobjRNG
.Clear
.CopyFromRecordset mobjRS
mobjRS.MoveFirst
End With
Next I

' Close Excel Workbook:
mobjWB.Close SaveChanges:=True

' Quit Excel:
mobjXL.Quit

' Show complete message:
MsgBox "Export Complete", _
vbOKOnly + vbInformation, "Information"

Exit_ExportToExcel:

' Destroy Excel objects:
Set mobjWS = Nothing
Set mobjWB = Nothing
Set mobjXL = Nothing

' Destroy DAO objects:
If Not mobjRS Is Nothing Then
mobjRS.Close
Set mobjRS = Nothing
End If
Set mobjDB = Nothing

Exit Sub

Error_ExportToExcel:

MsgBox "Error No: " & Err.Number _
& vbNewLine _
& "Description:" & vbNewLine _
& Err.Description, _
vbExclamation + vbOKOnly, "Error"
Resume Exit_ExportToExcel

End Sub


' CODE ENDS


Geoff
 
Back
Top