Moving Access Query to Excel 1

[bill420]

I need VBA code to move a Query to a Excel spreadsheet that already exist. I can Click and Drag the query to the opening sheet of the Excel, but I need a easier method for my users. I have tried to use OutputTo command but it just overwrites the entire spreadsheet.
Thanks for your help.

 

[rubbernilly]

Try this...

sInsert = "INSERT * INTO [Excel 8.0;DATABASE=" & _
          [red]sFileName[/red] & ";HDR=Yes;IMEX=0].[" & _
          [red]sSheetName[/red] & "] FROM [red]YOURQUERYNAME[/red]"
    
If Len(sFilter) > 0 Then
   sInsert = sInsert & " WHERE " & sFilter
End If
    
CurrentDb.Execute sInsert

Also, check this thread out for some code that manipulates Excel. That might give you some ideas, too:

http://www.tek-tips.com/viewthread.cfm?qid=1137585&page=2

And this thread for various ways to get data into Excel:

http://www.tek-tips.com/viewthread.cfm?qid=1137319

 

[bill420]

Thanks "rubbernilly" for your reply, however, being new to Access and coding using VBA, I'm unable to follow your solution. After I have assigned sFileName, sSheetname and Query Name to the file, sheet and query used, I am receiving compile errors. After looking at the other examples you've provided, I'm not able to make it function.
bill420

 

[rubbernilly]

To make the above work, you will need to dimension the various strings

dim sInsert as string
dim sFilename as string
dim sFilter as string

sFilter is only there in case you want a subset of the data in that query. If you don't need it you can remove it and the If-Then statement associated with it.

Also, make sure that the worksheet name exists in the book.

If it does not exist, you might need the SQL statement to begin:

"SELECT * INTO..."

...as this will create the worksheet.

"INSERT" will give you an error if the sheet isn't there, and "SELECT INTO" will give you an error if the sheet is there.

Try these fixes, and if they don't work, then we can modify code from one of the links I sent to get this to happen.

 

[bill420]

rubbernilly"
I'm now receiving Run-time error 3134, Syntax Error.
Here is the code as I have it:

Private Sub Option9_Click()


Dim sInsert As String
Dim sFileName As String

sFileName = "C:\btemp\test\Access_Test.xls"

sInsert = "INSERT * INTO [Excel 8.0;DATABASE=" & _
sFileName & " ;HDR=Yes;IMEX=0].[" & _
"Sheet2" & "] FROM Excel_Test"

'If Len(sFilter) > 0 Then
'sInsert = sInsert & " WHERE " & sFilter
'End If

CurrentDb.Execute sInsert

End Sub

Your help is greatly appreciated.
bill420

 

[rubbernilly]

OK, sorry...

Fingers got faster than my brain...

Try this...

Private Sub Option9_Click()

    
     Dim sInsert As String
     Dim sFileName As String
      
     sFileName = "C:\btemp\test\Access_Test.xls"
     
     sInsert = "INSERT INTO [Excel 8.0;DATABASE=" & _
          sFileName & ";HDR=Yes;IMEX=0].[" & _
          "Sheet2" & "] SELECT * FROM Excel_Test"
    
    'If Len(sFilter) > 0 Then
    'sInsert = sInsert & " WHERE " & sFilter
    'End If
    
CurrentDb.Execute sInsert
  
    End Sub

Had the syntax of the SQL wrong. My bad.

 

[bill420]

Hi "rubbernilly"
Finally got back to Access to try this, it creates a new worksheet no matter what I name it. If I call the worksheet "Sheet2" it creates a "Sheet21", I tried to rename it to "Start" with the same results, creates "Start1".
Any clues as to why this is happening.
Thanks again for all your help yesterday and look forward to hearing your reply.
bill420

 

[rubbernilly]

It might be because of the format of your existing sheet. WHen I run this sort of code, I get the output to go to the same sheet every time.

Try this...

Add a new sheet to your workbook called "Output," and change the SQL statement above to write to this new sheet. It should write to it no problem. Then run the same code a second time to see if you get double the number of records or a second sheet named "output1".

If it turns out to be because of the format of your sheet, you can remake your SQL statement/Source Query so that the data is in the right order and of the right data type. For instance, outputting "*" means outputting any autonumber field you have in your query. Likely that is just a field in access and not in your Excel spreadsheet, so you might want to not "SELECT * FROM Excel_Test". You might want to explicitly name the fields in the order you want to select them.

You might be better off automating Excel through an object. Here is code to get you started with that:

Dim sFilter As String
Dim objExcel As Excel.Application, xlWS As Object, xlWR As Object
Dim fs As Object
Dim sFileName As String
Dim qd As DAO.QueryDef, rs As DAO.Recordset, rsf As DAO.Recordset

Screen.MousePointer = 11 'hourglass

sFileName = "C:\btemp\test\Access_Test.xls"

Set fs = CreateObject("Scripting.FileSystemObject")

Set objExcel = CreateObject("Excel.Application")
    If fs.FileExists(sFileName) Then
       objExcel.Workbooks.Open sfilename
       Set xlWS = objExcel.Worksheets([red]"Your Sheet Name"[/red])
    Else
       objExcel.Workbooks.Add
       objExcel.Workbooks(1).SaveAs sFileName
       Set xlWS = objExcel.Worksheets.Add
       xlWS.Name = [red]"Your Sheet Name"[/red]
    End If
    objExcel.Visible = False
    objExcel.Range("A1:A2").Select

    Set qd = CurrentDb.QueryDefs("Excel_Test")
    Set rs = qd.OpenRecordset()
    sFilter = [red]"Enter your Filter or use a function " & _
              "(ie, DLookup) to get a Filter if you need " & _
              "to limit your query returns."[/red]
    rs.Filter = sFilter
    Set rsf = rs.OpenRecordset
    [maroon]Set xlWR = objExcel.Worksheets(xlWS.Name).Range("A1")[/maroon]
    xlWR.CopyFromRecordset rsf

    objExcel.Workbooks(1).Save

    objExcel.DisplayAlerts = False
[green]'   un-remark these lines if you want to remove sheets that
'   retain their default names (Sheet1, Sheet2, etc.)
'   For a = objExcel.Sheets.Count To 1 Step -1
'      If Left(objExcel.Sheets(a).Name, 5) = "Sheet" Then
'         If objExcel.Sheets.Count = 1 Then
'         Else
'            objExcel.Sheets(a).Delete
'         End If
'      End If
'   Next a[/green]
    objExcel.Workbooks(1).Save
    objExcel.DisplayAlerts = True
    objExcel.Range("A1:A2").Select
    objExcel.Workbooks(1).Close

Set xlWR = Nothing
Set xlWS = Nothing
objExcel.Quit
Set objExcel = Nothing
Set fs = Nothing
Set qd = Nothing
Set rs = Nothing
Set rsf = Nothing
Screen.MousePointer = 0 'normal

MsgBox "Export Completed.", vbOKOnly, "Export"

The trick of that code is that before the line:

[maroon]Set xlWR = objExcel.Worksheets(xlWS.Name).Range("A1")[/maroon]

You need to find and locate the range of the first empty cell where you want to output the data. You might have luck with...

objExcel.Selection.End(xlDown).Select
set xlwR = objExcel.ActiveCell.Offset(1,0)


This is a lot to digest, and I'm not convinced that I caught all the potential bugs as I typed this up, so post back with any problems/questions.

Good luck!

 

[rubbernilly]

One bug that might slip through is that if the file exists, the code assumes that the sheet exists. There should be a test there to make sure the sheet exists and if it does not, then it should add a sheet and rename it.

HTH

 

[bill420]

rubbernilly"
Your code worked GREAT. Thank you for all your time and effort on this problem. As we have recently converted to Access from Excel, I now have a method of retaining the Excel reports for the users.
I'm sure this won't be the last problem I have...
Thanks again for your great help.
bill420