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:
Code:
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!
