Solved

Exporting Access Query to an Excel Spreadsheet

Posted on 2007-12-04
5
1,835 Views
Last Modified: 2009-08-20
I have a query called "usp_Anomalies" that I would like to export to an Excel sheet. I have the following code that works and that I have attached as a code snippet. The only thing left is the export process. Please note that the data of the query must be exported including the COLUMN NAMES of the query.


Dim sSQL As String

  Dim objXL As Object

  Dim objWB As Object

  Dim sFile As String

  Dim sShtName As String

  Dim i As Integer

 

  'Set name of file to save to

  sFile = "C:\ANOMALIES.XLS"

 

  'Set name of new sheet

  sShtName = "ANOMALIES"

 
 

  'Create a new excel document

  Set objXL = CreateObject("Excel.Application")

 

  'create new workbook

  Set objWB = objXL.Workbooks.Add

  

  'Save as a new file, delete existing file if it exists

  If Dir$(sFile) <> "" Then Kill sFile

  objWB.SaveAs sFile

  

  objWB.Close

  objXL.Quit

 

  'CLOSE DOWN

  Set objWB = Nothing

  Set objXL = Nothing

Open in new window

0
Comment
Question by:pancho_alvarez
5 Comments
 
LVL 11

Accepted Solution

by:
TWBit earned 250 total points
ID: 20405323
How about this:

    DoCmd.OutputTo acOutputQuery, [YourQuery], acFormatXLS, sFile
0
 

Expert Comment

by:Vittles
ID: 20405330
I have the following code attached to a button on one form that 'dumps' the behind the scenes query into excel (nothing fancy):  
DoCmd.OutputTo acOutputForm, "Query Name", acFormatXLS, , True

I also have a more complex code set up for another that updates, exports, formats & saves a table based on a query (converted the query contents to a table in order to avoid memo fields being cut off at 250 characters) that looks like the following:  

Sub export_to_excel click()    

DoCmd.SetWarnings False
DoCmd.OpenQuery "Current Table Contents-Delete query", acViewNormal, acEdit
DoCmd.Close acQuery, "Current Table Contents-Delete query"
DoCmd.OpenQuery "Update with new data to be Exported-Append query", acViewNormal, acEdit
DoCmd.Close acQuery, "Update with new data to be Exported-Append query"
DoCmd.SetWarnings True
    Dim objXL As Object
    Dim objWB As Object
    Dim objSheet As Object
    Dim rs As DAO.Recordset
    Dim i As Integer
    Dim lRow As Long
    Dim Pth
    Pth = CurrentProject.Path & "\File name.xls"
    On Error Resume Next
    Kill Pth
   
    Set rs = CurrentDb.OpenRecordset("End Table name")
    Set objXL = CreateObject("Excel.Application")
    Set objWB = objXL.Workbooks.Add
    Set objSheet = objXL.ActiveSheet
   
    'Create Header - set to hold 5 fields (increase 0 to 4 range if there are more)
    For i = 0 To 4
        objSheet.Cells(1, i + 1).Value = rs.Fields(i).Name
    Next i
       
    'Fill in with data (4 columns)
    lRow = 2
    Do While Not rs.EOF
        For i = 0 To 4
            objSheet.Cells(lRow, i + 1).Value = rs.Fields(i).Value
        Next i
        rs.MoveNext
        lRow = lRow + 1
    Loop
   
    objSheet.Range("A1:E1").Font.Bold = True
    objSheet.Rows("1:1").RowHeight = 21
    objSheet.Columns("A:B").autofit
    objSheet.Columns("C").ColumnWidth = 40
    objSheet.Columns("E").ColumnWidth = 40
    objSheet.Columns("D").ColumnWidth = 20
    objSheet.Columns("A:E").WrapText = True
    objSheet.Range("A2:E2000").VerticalAlignment = xlCenter
   
    With objSheet.Rows("1:1").Interior
        .ColorIndex = 15
        .Pattern = xlSolid
    End With
   
   objSheet.Rows(2).Select
   objXL.ActiveWindow.FreezePanes = True

    objWB.SaveAs Pth

   rs.Close
   Set rs = Nothing

   objXL.Visible = True

End Sub


0
 
LVL 39

Expert Comment

by:stevbe
ID: 20405752
This is stock code from the Excel help file for the CopyFromRecordset function that sets the field names and copies all the data in 1 shot which is much faster than looping.

For iCols = 0 to rs.Fields.Count - 1
    ws.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
Next
ws.Range(ws.Cells(1, 1),  ws.Cells(1, rs.Fields.Count)).Font.Bold = True
ws.Range("A2").CopyFromRecordset rs

Steve
0
 

Expert Comment

by:Vittles
ID: 20405920
Good to know - I replaced that section in my own code.  Thanks!
0
 
LVL 59

Expert Comment

by:Saurabh Singh Teotia
ID: 20407644
Well try this...

Define the name in the sheet where u want to paste the data from access to excel

Sub ImportAccess()
Dim MyAccess As Database
Dim MyTemp As DAO.Recordset

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.StatusBar = "Importing Data From Access"

Sheets("Your Sheet Name").Select
Range("Your Range Name").Select
Selection.clearcontents

Set MyAccess = OpenDatabase("Your database path")

Set MyTemp = MyAccess.OpenRecordset("usp_Anomalies")

'**********Importing From Access**********
Sheets("Your Sheet Name").Select
Range("Your Range Name").Select
Selection.CopyFromRecordset MyTemp


Range("a1").Select
End Sub
0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

The first two articles in this short series — Using a Criteria Form to Filter Records (http://www.experts-exchange.com/A_6069.html) and Building a Custom Filter (http://www.experts-exchange.com/A_6070.html) — discuss in some detail how a form can be…
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now