Re: Export a reprot to Excel

Missing reference. You need a reference to the DAO library.
(Access 2000 to 2003)
-- Type Control-G to open up the VBA window
-- Select Tools: References from the menu
-- Find Microsoft DAO 3.? Object Library and check it. (Probably DAO 3.6)
-- Click OK
-- Select Debug.Compile from the menu and see if the code compiles successfully. If not, fix the problem and try to compile again.


John Spencer
Access MVP 2002-2005, 2007-2008
Center for Health Program Development and Management
University of Maryland Baltimore County

Public wrote:
Thanks for your response.
However, when I tried the code, I faced the following compilation error
"Copilation Error: User-defined type is not defined"
and the code highlighted the following code "rst As DAO.Recordset"

Any idea?


"Jeanette Cunningham" wrote:

Here is an answer I wrote some months ago.
You will need to tweak it a bit to exactly fit your situation.

Your situation needs a different strSQL and a different strFirstCell each time you do the copy from recordset routine.
'------------------------
'replace the following with your own strings
'strDocPath = "c:\documents and settings\Jeanette\desktop\TemplateB.xls"
'strPath = "c:\documents and settings\Jeanette\desktop\Text.xls"
'strFirstCell = "A5"
'strWsName = "Sheet1"
'strSQL can be a saved query,
'or a saved table,
'or a sql statement
'strSql = "SELECT yadda, yadda " _
' & "FROM yadda " _
' & "WHERE yadda " _
' & "ORDER BY yadda"
'if your template has more than 1 work***
'you can choose which work*** will receive the data
'you can choose which cell to start copying the data to
'------------------------
Public Sub CopyRecordset2XLTemplate()
On Error GoTo SubErr
Dim objXLApp As Object 'Excel.Application
Dim objXLWs As Object 'Excel.Work***
Dim strWsName As String 'name of work***
Dim strFirstCell As String 'starting point to add the data
Dim rst As DAO.Recordset
Dim strDocPath 'full path and name of template
Dim strPath As String 'full path and name to save file as
Dim strSQL As String 'data to export, table, query or sql statement


Const xlCellTypeLastCell = 11
Const xlContinuous = 1
Const xlAutomatic = -4105


'strDocPath = "c:\documents and settings\Jeanette\desktop\TemplateB.xls"
'strPath = "c:\documents and settings\Jeanette\desktop\Text.xls"
'strFirstCell = "A5"
'strWsName = "Sheet1"
'strSQL = "QueryName"

strDocPath = "c:\documents and settings\jc.ECJ-02.000\desktop\MyPersonxpt.xls"
strPath = "c:\documents and settings\jc.ECJ-02.000\desktop\MyNewPersonxpt.xls"

strWsName = "S1"
'name of the recordset to copy
strSQL = "qryNewStatusExport"
strFirstCell = "A4"


'replace with names and cell references that suit your template

' Populate the excel object
Set objXLApp = CreateObject("Excel.Application")
' Open the template workbook
objXLApp.Workbooks.Open (strDocPath)
' Save the template as the file specified by the user
objXLApp.ActiveWorkbook.SaveAs (strPath)

'Open a recordset on the table with query and work*** names
Set rst = CurrentDb.OpenRecordset(strSQL)
If rst.EOF Then
'handle error here
Else
' Select the appropriate work***
Set objXLWs = objXLApp.ActiveWorkbook.Worksheets(strWsName)
' Activate the selected work***
objXLWs.Activate
' Ask Excel to copy the data from the recordset starting with strFirstCell
objXLWs.Range(strFirstCell).CopyFromRecordset rst

' Select the main work***
objXLApp.Worksheets(strWsName).Activate
' Activate the selected work***
Set objXLWs = objXLApp.ActiveWorkbook.Worksheets(strWsName)
'format cells
With objXLWs.Cells
.Range(.Cells(1, 1), .Cells(1, _
1).SpecialCells(xlCellTypeLastCell)).Borders.LineStyle = _
xlContinuous
.Range(.Cells(1, 1), .Cells(1, _
1).SpecialCells(xlCellTypeLastCell)).Borders.ColorIndex = _
xlAutomatic
.Font.Size = 9
.Font.Name = "Arial Narrow"
.WrapText = True

End With

End If


'**error handling, in the Sub exit - make sure you set the object
'references to nothing as shown below.

SubExit:
' Save the workbook
objXLApp.ActiveWorkbook.Save
Set objXLWs = Nothing
Set objXLApp = Nothing
' Destroy the recordset and database objects
rst.Close
If Not rst Is Nothing Then
Set rst = Nothing
End If

Exit Sub

SubErr:
MsgBox Err.Description & " " & Err.Number
Resume SubExit
End Sub
'-------------------------------


Jeanette Cunningham -- Melbourne Victoria Australia



"Public" <Public@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message news:02C57494-063F-4ABC-8F9A-F206B57BCACB@xxxxxxxxxxxxxxxx
Thanks.
I would go for VBA solution. Could you please tell me how do I do that?

Regards




.