Solved

Exporting Access Query to an Excel Spreadsheet

Posted on 2007-12-04
5
1,850 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

Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

I see at least one EE question a week that pertains to using temporary tables in MS Access.  But surprisingly, I was unable to find a single article devoted solely to this topic. I don’t intend to describe all of the uses of temporary tables in t…
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 create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

920 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

13 Experts available now in Live!

Get 1:1 Help Now