Access Query Result - how to save the results into an EXCEL Spreadsheet

[Pumpk1n]

I have the results of a query for which I would like to do the following:
1) Open an EXCEL workbook
2) Copy/paste the data from ACCESS into the new workbook
3) Save the workbook to a specific location, but prompt the user for the date which then gets appended to the file name.

In follow up to the above, multiple queries -- is there a way to create a a unique tab for each of the queries and save it to a tab in the workbook?

 

[alansidman]

check out this link..

AccessBlog.net: Export to Excel range: Tips and tricks, news, links, downloads on Microsoft Access

 

[Pumpk1n]

I'm a bit of a beginner on the VBA code. I found this coding which works to open the workbook and paste the data into Sheet 1. I need to repeat this 6 times and have 6 unique tabs in the workbook. I'd also like to name the tabs rather than Sheet 1 to be a specific tab name. Can you help with this code?


Option Compare Database
'This module requires references to the
' following object libraries:
'
' 1. Microsoft Excel X.X Object Library,
' where X.X is the Excel Version Number.
'
' 2. One of the following:
'
' For mdb files:
' Microsoft DAO 3.6 Object Library
' (DAO360.DLL)
' For ACCDB files (Access 2007):
' Microsoft Office 12 Access Database Engine Objects
' (ACEDAO.DLL)
' This reference should be set already.
'
' To set the reference, in the VBA editor:
' Tools > References.
Private Sub SaveRecordsetToExcelRange()
' Excel constants:
Const strcXLPath As String = "MyWorkbook.xlsx" <== I've made this generic - - my code has the right LAN location.
Const strcWorksheetName As String = "Sheet1"
Const strcCellAddress As String = "A4"

' Access constants:
Const strcQueryName As String = "TestExportQuery"

' Excel Objects:
Dim objXL As Excel.Application
Dim objWBK As Excel.Workbook
Dim objWS As Excel.Worksheet
Dim objRNG As Excel.Range


' DAO objects:
Dim objDB As DAO.Database
Dim objQDF As DAO.QueryDef
Dim objRS As DAO.Recordset


On Error GoTo Error_Exit_SaveRecordsetToExcelRange

' Open a DAO recordset on the query:
Set objDB = CurrentDb()
Set objQDF = objDB.QueryDefs(strcQueryName)
Set objRS = objQDF.OpenRecordset

' Open Excel and point to the cell where
' the recordset is to be inserted:
Set objXL = New Excel.Application
objXL.Visible = True
Set objWBK = objXL.Workbooks.Open(strcXLPath)
Set objWS = objWBK.Worksheets(strcWorksheetName)
Set objRNG = objWS.Range(strcCellAddress)
objRNG.CopyFromRecordset objRS

' Destroy objects:
GoSub CleanUp

Exit_SaveRecordsetToExcelRange:
Exit Sub

CleanUp:
' Destroy Excel objects:
Set objRNG = Nothing
Set objWS = Nothing
Set objWBK = Nothing
Set objXL = Nothing

' Destroy DAO objects:
If Not objRS Is Nothing Then
objRS.Close
Set objRS = Nothing
End If
Set objQDF = Nothing
Set objDB = Nothing

Return

Error_Exit_SaveRecordsetToExcelRange:
MsgBox "Error " & Err.Number _
& vbNewLine & vbNewLine _
& Err.Description, _
vbExclamation + vbOKOnly, _
"Error Information"

GoSub CleanUp
Resume Exit_SaveRecordsetToExcelRange
End Sub