[AccessD] Export data from query to Excel

Here is a method from a Excel class I wrote. This assumes an instance of
Excel exists (AppXcel) and uses two functions (SheetExists and
RangeNameExists)which I can send if you don't have them. If a range name is
supplied it will paste to the range. If no range is supplied it will clear
the sheet and paste starting in cell A2 (I usually have labels in row 1). If
blPaste is true it doesn't clear the worksheet but pastes the recortset at
the bottom of the previous paste. This allows multiple queries to be pasted
one after the other to the same sheet. HTH
Jim Hale

Public Function PasteRecSetExcel(strSheetName As String, _
rstData As Recordset, Optional blPaste As Boolean = False, Optional
strWSRange As String) As Boolean

Dim wksUpl As Worksheet, y As Long, lngRetval As Long, blSheet As Boolean,
blRange As Boolean
On Error GoTo PROC_ERR
blSheet = SheetExists(strSheetName)
blRange = RangeNameExists(strWSRange)
If strWSRange = "" Then blRange = True
If rstData.RecordCount = 0 Then
    MsgBox rstData.Name & " is empty. There are no records to paste ", _
    vbOKOnly + vbCritical + vbSystemModal + vbDefaultButton1, _
    "Empty Recordset"
    PasteRecSetExcel = False
ElseIf blSheet = False Then
    MsgBox strSheetName & " doesn't exist.", _
    vbOKOnly + vbCritical + vbSystemModal + vbDefaultButton1, _
    "Non-existent Sheet"
    PasteRecSetExcel = False
ElseIf blRange = False Then
    MsgBox strWSRange & " is not a valid range name. No data was pasted.", _
    vbOKOnly + vbCritical + vbSystemModal + vbDefaultButton1, _
    "Range does not exist"
    PasteRecSetExcel = False
Else
    'Load Data into Excel
    Set wksUpl = appXcel.Worksheets(strSheetName)
    If strWSRange = "" Then 'if range name exists use different paste method
        If blPaste = True Then
            'true means find first empty cell before pasting the recordset
            y = appXcel.WorksheetFunction.CountA(wksUpl.Range("A:A"))
            wksUpl.Cells(y + 1, 1).CopyFromRecordset rstData
        Else
            'false means clear th sheet and paste the new data beginning in
A2
            wksUpl.Range("A2:IV65536").ClearContents
            wksUpl.Range("A2").CopyFromRecordset rstData
        End If
    Else
            wksUpl.Range(strWSRange).ClearContents
            wksUpl.Range(strWSRange).CopyFromRecordset rstData
    End If
PasteRecSetExcel = True
End If
PROC_EXIT:
    If (rstData Is Nothing) = False Then Set rstData = Nothing
    If (wksUpl Is Nothing) = False Then Set wksUpl = Nothing
  Exit Function
  
PROC_ERR:
    PasteRecSetExcel = False
    If Err.Number = 1004 Then
        MsgBox "UseExcel.Class Error: Range " & strWSRange & " does not
exist.", , _
        "PasteRecSetExcel Method"
    Else
        MsgBox "UseExcel.Class Error: " & Err.Number & ". " &
Err.Description, , _
        "PasteRecSetExcel Method"
    End If
  Resume PROC_EXIT

End Function
-----Original Message-----
From: Reuben Cummings [mailto:reuben at gfconsultants.com]
Sent: Thursday, December 14, 2006 9:44 AM
To: AccessD
Subject: [AccessD] Export data from query to Excel


I can't get anything from the archives right now...

Anyone got a nice routine for exporting data from a query to an excel
spreadsheet?

I have a query that I will change the criteria in to get the specific
results I need.  I then want to run a routine to export that data to a new
worksheet.  The query structure will always be the same - just different
data.

So all I need is a way to export the data while allowing me to create the
worksheet name at the time of the export.  I have to do this about 150 times
so automation would be nice.

Thanks.

Reuben Cummings
GFC, LLC
812.523.1017

***********************************************************************
The information transmitted is intended solely for the individual or
entity to which it is addressed and may contain confidential and/or
privileged material. Any review, retransmission, dissemination or
other use of or taking action in reliance upon this information by
persons or entities other than the intended recipient is prohibited.
If you have received this email in error please contact the sender and
delete the material from any computer. As a recipient of this email,
you are responsible for screening its contents and the contents of any
attachments for the presence of viruses. No liability is accepted for
any damages caused by any virus transmitted by this email.