Exporting Recordset to Spreadsheet

Question

Just getting to grips some VBA (this stuff's new to me so bear with us!)

From query ContactDetails_SurveySoftOutcomes, I'm trying to first find a list of all the unique values in the DeptName field in that query, hence the rsGroup Dim storing a Grouped query on the DeptName field.

I'm then going to use this grouped list as way of cycling through the same query again, but passing through each unique entry as a filter on the whole recordset and export each filtered recordset to its own Excel spreadsheet... see the Do While Not loop.

My code's tripping up on the DoCmd.TransferSpreadsheet ... rsExport part. I'm a bit new to this, but I guess my Dim name rsExport for the recordset isn't accepted in this method..?

Is there an easy fix to the code I've already started or should I be using a completely different approach to achieve all this?

Code:

Public Sub ExportSoftOutcomes()

Dim rsGroup As DAO.Recordset
Dim Dept As String
Dim myPath As String

myPath = "C:\MyFolder\"

Set rsGroup = CurrentDb.OpenRecordset("SELECT ContactDetails_SurveySoftOutcomes.DeptName " _
& "FROM ContactDetails_SurveySoftOutcomes GROUP BY ContactDetails_SurveySoftOutcomes.DeptName", dbOpenDynaset)

Do While Not rsGroup.EOF

    Dept = rsGroup!DeptName

    Dim rsExport As DAO.Recordset
    Set rsExport = CurrentDb.OpenRecordset("SELECT * FROM ContactDetails_SurveySoftOutcomes " _
    & "WHERE (((ContactDetails_SurveySoftOutcomes.DeptName)='" & Dept & "'))", dbOpenDynaset)

    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, rsExport, myPath & Dept & "\" & Dept & " - Soft Outcomes Survey.xls", True

    rsGroup.MoveNext

Loop

End Sub

Fixed Code:

Public Sub ExportSoftOutcomes()

Dim rsGroup As DAO.Recordset
Dim Dept As String
Dim myPath As String

myPath = "C:\MyFolder\"

Set rsGroup = CurrentDb.OpenRecordset("SELECT ContactDetails_SurveySoftOutcomes.DeptName " _
& "FROM ContactDetails_SurveySoftOutcomes GROUP BY ContactDetails_SurveySoftOutcomes.DeptName", dbOpenDynaset)

Do While Not rsGroup.EOF
    Dept = rsGroup!DeptName

    Dim rsExportSQL As String
    rsExportSQL = "SELECT * FROM ContactDetails_SurveySoftOutcomes " _
    & "WHERE (((ContactDetails_SurveySoftOutcomes.DeptName)='" & Dept & "'))"

    Dim rsExport As DAO.QueryDef
    Set rsExport = CurrentDb.CreateQueryDef("myExportQueryDef", rsExportSQL)

    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "myExportQueryDef", myPath & Dept & "\" & Dept & " - Soft Outcomes Survey.xls", True

    CurrentDb.QueryDefs.Delete rsExport.Name

    rsGroup.MoveNext
Loop

End Sub

Answer 1

You're right that your rsGroup parameter is wrong, Access expects a table name or select query.

Try this code:

strExport = "SELECT * FROM ContactDetails_SurveySoftOutcomes " _
& "WHERE (((ContactDetails_SurveySoftOutcomes.DeptName)='" & Dept & "'))"

Set qdfNew = CurrentDb.CreateQueryDef("myExportQueryDef", strExport)

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "myExportQueryDef", myPath & Dept & "\" & Dept & " - Soft Outcomes Survey.xls", True

CurrentDb.QueryDefs.Delete qdfNew.Name 'cleanup

Hope that works