ACCESS: Macro to export query results to specific tab in Excel spreadsheet, whilst overwriting existing contents.

Never Mind, I found a solution to the problem by using Leigh's Generic Recordset along with this one...Perfect match.

Bob, I am trying to do something very similar as what is referred to in these posts.  I don't fully grasp all the VBA but copied the info into my own database.  I have 3 queries that I am trying to export to a single Excel workbook, each query placed into its own sheet in that workbook.  Here is a copy of my code (still in testing phase, so file is on my desktop):

Private Sub cmdBenderExport_Click()

Call SendTQ2XLWbSheet("qryBenderEfficiencies_Crosstab", "qryBenderEfficiencies_Crosstab", "C:\Users\A\Desktop\ASXX\Mfg Data\BenderCharts.xlsm")

Call SendTQ2XLWbSheet("qryBenderEffic-Mo_Crosstab", "qryBenderEffic_Mo_Crosstab", "C:\Users\A\Desktop\ASXX\Mfg Data\BenderCharts.xlsm")

Call SendTQ2XLWbSheet("qryBenderEffic-Wk_Crosstab", "qryBenderEffic_Wk_Crosstab", "C:\Users\A\Desktop\ASXX\Mfg Data\BenderCharts.xlsm")

End Sub

Public Function SendTQ2XLWbSheet(strTQName As String, strSheetName As String, strFilePath As String)

' strTQName is the name of the table or query you want to send to Excel

' strSheetName is the name of the sheet you want to send it to

' strFilePath is the name and path of the file you want to send this data into.

    Dim rst As DAO.Recordset

    Dim ApXL As Object

    Dim xlWBk As Object

    Dim xlWSh As Object

    Dim fld As Field

    Dim blnSaveAs As Boolean

    Dim i As Long

    Dim strPath As String

    Const xlCenter As Long = -4108

    Const xlBottom As Long = -4107

    On Error GoTo err_handler

    strPath = strFilePath

    Set rst = CurrentDb.OpenRecordset(strTQName)

    If rst.RecordCount = 0 Then

        MsgBox "There are no records to export"

        Exit Function

    End If

    Set ApXL = CreateObject("Excel.Application")

    Set xlWBk = ApXL.Workbooks.Open(strPath)

    ApXL.Visible = True

    Set xlWSh = xlWBk.Worksheets(strSheetName)

        xlWSh.Cells.Clear

    For i = 0 To rst.Fields.Count - 1

        xlWSh.Cells(1, i + 1) = rst.Fields(i).Name

    Next i

    rst.MoveFirst

    xlWSh.Range("A2").CopyFromRecordset rst

    ' does the "autofit" for all columns

    xlWSh.Cells.EntireColumn.AutoFit

    rst.Close

    Set rst = Nothing

    ApXL.DisplayAlerts = False

    If Dir(strFilePath) = "" Then

        xlWBk.SaveAs strFilePath

    Else

        xlWBk.Save

    End If

    xlWBk.Close

    ApXL.DisplayAlerts = True

    ApXL.Quit

    Set ApXL = Nothing

    Exit Function

err_handler:

    DoCmd.SetWarnings True

    MsgBox Err.Description, vbExclamation, Err.Number

End Function

One of the queries works fine, as there is no criteria for that.  The other two require a range of dates.  Here is a sample of one of the criteria:  Between [Forms]![frmMainMenu]![txt6WksEarlier] And [forms]![frmMainMenu]![txtDate].  

 I am getting Error 3061 "Too few parameters.  Expected 2" for both of these queries, and of course no results show up in the workbook for these two queries.

Hi,

Any criteria in your queries will result in errors using the code provided. Try to do the below and see what happens.

Replace               Set rst = CurrentDb.OpenRecordset(strQRYName)

With                    Set rst = fDAOGenericRst(strQRYName)

Create another new module with:

Function fDAOGenericRst(strSQL As String, _

                    Optional intType As DAO.RecordsetTypeEnum = dbOpenDynaset, _

                    Optional intOptions As DAO.RecordsetOptionEnum, _

                    Optional intLock As DAO.LockTypeEnum, _

                    Optional pdb As DAO.Database) As DAO.Recordset

    Dim db As Database

    Dim qdf As QueryDef

    Dim rst As DAO.Recordset

    Dim prm As DAO.Parameter

    If Not pdb Is Nothing Then

        Set db = pdb

    Else

        Set db = CurrentDb

    End If

    On Error Resume Next

    Set qdf = db.QueryDefs(strSQL)

    If Err = 3265 Then

        Set qdf = db.CreateQueryDef("", strSQL)

    End If

    On Error GoTo 0

    For Each prm In qdf.Parameters

        prm.Value = Eval(prm.Name)

    Next

    If intOptions = 0 And intLock = 0 Then

        Set rst = qdf.OpenRecordset(intType)

    ElseIf intOptions > 0 And intLock = 0 Then

        Set rst = qdf.OpenRecordset(intType, intOptions)

    ElseIf intOptions = 0 And intLock > 0 Then

        Set rst = qdf.OpenRecordset(intType, intLock)

    ElseIf intOptions > 0 And intLock > 0 Then

        Set rst = qdf.OpenRecordset(intType, intOptions, intLock)

    End If

    Set fDAOGenericRst = rst

    Set prm = Nothing

    Set rst = Nothing

    Set qdf = Nothing

    Set db = Nothing

End Function

Regards,

Thank you - it worked!!  The revision to the first module, and then adding the generic function worked beautifully.  As a side note:  I had a macro in the Excel spreadsheet which I no longer needed so I could save it as a regular workbook, rather than a macro-enabled workbook.   By doing so, it eliminated any residual error messages.  Many, many thanks!!

No worries, happy to hear it worked for you. 

Good of luck with your project.