Export Access Query to Excel (1 Viewer)

[ShanVel]

Folks,

I have a form with combo box (cboProjForRptSeltn ) and two command buttons. The combo box is filled with name of the reports. The combo box has two columns, column 1 is the name of the report and column 2 is the bound column which also is the link field (primary key) to limit the records.

When the user selects an item from cbo box and click the "Preview Risk Table" command button it will open a report in preview mode. The report's "Record Source" property is set to a UNION query (qryRprtRskTbl) which pull the records from several tables. The report's "Filter" property is set to the following criteria:
“qryRprtRskTbl.P.intProjectId=Forms!frmReportSelectionBlrR1!cboProjForRptSeltn”

The above criteria is nothing but filter based on the value of the cbo box.

The click event procedure is as follows:
Private Sub cmdPreviewRprt_Click()
Dim strDocName As String
strDocName = "rptRskTblProjectWise"
DoCmd.OpenReport strDocName, acPreview, "qryRprtRskTblFilter_r1"
End Sub
"qryRprtRskTblFilter_r1" is another query out of the UNION query I mentioned above (qryRprtRskTbl). qryRprtRskTblFilter_r1 is pulling all the records from qryRprtRskTbl which meets the projectID field selected in cbo box, which is also the same as the "Filter" property value of the report as indicated above.

Everything works fine with cbo box and "Preview Risk Table" command button. It just pull all the records for the project selected under cbo box and display it as report in preview mode. Looks great!!

Here's my problem. I wanted to export the same report that was previewed by the user to Excel. For this I am using, another command button called “Export to Excel”. The click event of this procedure is as shown below:

Private Sub cmdExportToExcel_Click()
On Error Resume Next
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim xlWorkbook As Excel.Workbook

Dim acQuery As QueryDef
Dim objRST As Recordset
Dim strQueryName As String
Dim strSearch As String
'Dim strSQL As String

'strSearch = Me![cboProjForRptSeltn]

strQueryName = "qryRprtRskTblFilter_r1"
'strQueryName = "qryEffcyAllProjtsForRprt"

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWorkbook = xlApp.Workbooks.Add
Set objRST = Application.CurrentDb.OpenRecordset(strQueryName)


'Loop through the fileds collection and make each field name a column heading in Excel
Set xlSheet = xlWorkbook.Sheets(1)
For lvlColumn = 0 To objRST.Fields.Count - 1
xlSheet.Cells(1, lvlColumn + 1).Value = objRST.Fields(lvlColumn).Name
Next
'Change the font to bold for header row
xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, objRST.Fields.Count)).Font.Bold = True

' I have some codes here for formatting Excel cells …

'Send data from Recordset out to Excel
With xlSheet
.Range("A2").CopyFromRecordset objRST
.Name = Left(strQueryName, 31)
End With

Set xlSheet = Nothing
Set xlWorkbook = Nothing
Set xlApp = Nothing

End Sub

When I click the command button, it loads an instance of Excel and adds a workbook under the query name "qryRprtRskTblFilter_r1", but no data.

If I use another query say, "qryEffcyAllProjtsForRprt", which has no connection to cbo box value then it is cool, exports all the data to Excel without any problem.

I guess, you folks understand what I am trying to achieve here. Basically, I wanted to give the user some flexibility, either they can view the data as Access report or Export to Excel with same formatting feature and add more later if they want after exporting, as they see on Access report preview.

I have attached some of the query files I have described here. May be I can clarify more down the road, if necessary.

My bottom line question is: why the “qryRprtRskTblFilter_r1” query runs perfectly on Access reports but not when I want to run to export to Excel?

I don’t want to use the TransferSpreadsheet or outputTo method of docmd object, because I wanted to do some formatting before I export to excel.

Any help is greatly appreciated.

Thanks

ShanVel

 

[madrav72]

try having a look at this ...

dont know if this is what you want but have a gander at this ...
MasterSummary is the name of the query so you can change this.

Dim db As DAO.Database
Dim rs As DAO.Recordset
'Set db = DAO.DBEngine.Workspaces(0).OpenDatabase( _
"C:\database.mdb")
Set db = CurrentDb
Set rs = db.OpenRecordset("MasterSummary", dbOpenSnapshot)

'Start a new workbook in Excel
Dim oApp As New Excel.Application
Dim oBook As Excel.Workbook
Dim oSheet As Excel.Worksheet

Set oBook = oApp.Workbooks.Add
Set oSheet = oBook.Worksheets(1)

'Add the field names in row 1
Dim i As Integer
Dim iNumCols As Integer
iNumCols = rs.Fields.Count
For i = 1 To iNumCols
oSheet.Cells(1, i).Value = rs.Fields(i - 1).Name
Next

'Add the data starting at cell A2
oSheet.Range("A2").CopyFromRecordset rs

'Format the header row as bold and autofit the columns
With oSheet.Range("a1").Resize(1, iNumCols)
.Font.Bold = True
.EntireColumn.AutoFit
End With

oApp.Visible = True
oApp.UserControl = True

'Close the Database and Recordset
rs.Close
db.Close

hope that helps

 

[ShanVel]

Hi madrav72,

Thanks for your response. Let me take a look at your code and get back. I don't know how your MasterSummary query will look like. But, the equivalent of mine is a big union query with criteria (projectId field) field selected by the combo box bound column.

Thanks, again, for your response.

Shan.

 

[P_DUBS]

Is there any way Shanwels original code can be expanded to create a second sheet for a second set of query results?

 

[P_DUBS]

I've sorted it!

 

[analyst1]

I've tried madrav72's code, and replaced his query name (Master summary) with my own (ASP), but i cannot get it to work.

Any help?

 

[analyst1]

The exact coding i'm using is:

Private Sub cmdtransfer_Click()
Function test()

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel7, "ASP", "C:\Databases\Access to Excel.xls", True

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel7, "ASP2", "C:\Databases\Access to Excel.xls", True
End Function

End Sub

and i'm receiving the following error: 'Compile Error: Expected End Sub'

What does this mean (sorry, not very experienced with VB)?

 

[Leon123456]

You've tried to define a function inside a sub function. I'm guessing you want the export code to run from a button so you just need the sub function.


Private Sub cmdtransfer_Click()
Function test() <-- Delete this line

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel7, "ASP", "C:\Databases\Access to Excel.xls", True

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel7, "ASP2", "C:\Databases\Access to Excel.xls", True
End Function <-- Delete this too.

End Sub

 

[AnilBagga]

You've tried to define a function inside a sub function. I'm guessing you want the export code to run from a button so you just need the sub function.


Private Sub cmdtransfer_Click()
Function test() <-- Delete this line

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel7, "ASP", "C:\Databases\Access to Excel.xls", True

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel7, "ASP2", "C:\Databases\Access to Excel.xls", True
End Function <-- Delete this too.

End Sub

What are the values ASP and ASP2 in the statement. I want to Export a query (say qryTest) to an excel sheet. What should be the command button code in the click event??

 

[Minty]

This is an 11-year-old thread!

I would suggest you start a new one and show us what you have tried and highlight any errors you had?

 

[Auntiejack56]

Hi ShanVel,
Three guesses:
1) The recordset is somehow set to EOF when you try the second export. In other words, you run the Preview and see records, and then you run the Excel export and no records appear. If you close your app, then reopen and do the second export immediately, does it work?
2) To fix, use

 Set dbs=Currentdb()     
 Set objRST = dbs.OpenRecordset(strqueryname,dbOpenSnapshot)

instead of

application.currentdb.openrecordset

3) And also, in my experience, copyfromrecordset can be temperamental in some Access versions if you don't specify the number of lines. If possible, use something similar to

 .Range("A2").CopyFromRecordset objRST, 99999

Best of luck,
Jack

 

[Auntiejack56]

Hehe so it is. Bit of time travel never goes astray ...

 

[AnilBagga]

I

This is an 11-year-old thread!

I would suggest you start a new one and show us what you have tried and highlight any errors you had?

I have not tried it as I don't know how and where to use it!