Multiple TransferSpreadsheet Export To Same Workbook (1 Viewer)

Dugantrain

I Love Pants
Local time
Today, 18:03
Joined
Mar 28, 2002
Messages
221
Hi, I'm looking to do the following in the On-Click event of a command button:
Code:
DoCmd.TransferSpreadsheet 
acexport, , "Some_Query", "Some_FileName", 
False, "Some_Range"

And Then:
Code:
DoCmd.TransferSpreadsheet 
acexport, , "Different_Query", "Same_FileName", 
False, "Different_Range"

So, basically, I'm looking to export several queries to the same worksheet. However, I get errors when attempting to do so, when I try to export the second query, Access says that the query already exists. How can I get around this and have it export multiple queries to the same worksheet (and eventually have multiple queries paste to different worksheets within the same workbook?)
 
Last edited:
what you need to do is run the query in code and then open the excel object. then if u want to use the sameworksheet then set the new range to paste in the query.

On Error GoTo ErrorHandler

Set db = CurrentDb()
Set rs = db.OpenRecordset("YOURQUERYNAME", dbOpenDynaset)

'If recordset has no data then message and exit Procedure
If rs.RecordCount = 0 Then
DisplayMessage "There are no records to export?"
Exit Sub
End If

Set xlApp = CreateObject("Excel.Application")
Set Workbook = xlApp.Workbooks.Add
Set Sheet = xlApp.ActiveWorkbook.Sheets(1)

DoCmd.Hourglass True

j = 1

'Open Excel, maximise it and disable alerts.
With xlApp
.WindowState = xlMaximized
.DisplayAlerts = False
.Interactive = True
.Visible = True

'Loop through the Microsoft Access field names and create the Microsoft Excel labels.
For i = 0 To rs.Fields.Count - 1
CurrentValue = rs.Fields(i).Name
Sheet.Cells(j, i + 1).Value = CurrentValue
Next i

j = 2

'Loop through the Microsoft Access records and copy the records to the Microsoft Excel spreadsheet.
Do Until rs.EOF
For i = 0 To rs.Fields.Count - 1
CurrentField = rs(i)
Sheet.Cells(j, i + 1).Value = CurrentField
Next i
rs.MoveNext
j = j + 1
Loop


'Format cells
.Cells.Select
.Cells.EntireColumn.AutoFit
.Cells.EntireRow.AutoFit
.Selection.Sort Key1:=.Range("C2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

'Find the last cell and set to variable intLastRow to it
.Range("A1").Select
.ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(.ActiveCell)
.ActiveCell.Offset(1, 0).Select
Loop

intLastRow = .ActiveCell.Row

'Set the range for each column for use in criteria checking
Set rngPID = .Range(.Cells(1, 1), .Cells(intLastRow, 1))

'
'
'
'
'
'
'
End With

'Set objects to nothing
Set Sheet = Nothing
Set Workbook = Nothing
Set xlApp = Nothing
Set rs = Nothing
Set db = Nothing

DoCmd.Hourglass False

'------------------------------------------------------------
' Error Handling
'------------------------------------------------------------
Exit_Errorhandler:
Exit Sub

ErrorHandler:
DoCmd.Hourglass False
MsgBox Err.Description
Resume Exit_Errorhandler

End Sub
 
Your code reeks of both Automation and DAO, two things that I haven't had a chance to learn because of the time demands put upon me. This is exactly what I was looking for though, thanks very much for the info and I'll begin the digestion immediately!
 

Users who are viewing this thread

Back
Top Bottom