Exporting recordsets to code

[Mcgrco]

Ive got a big table in a database which i need to break down by Column owner. For each Column owner I need to creatan excel spreadsheet.

Currently im using some sql in code to create a seperate table for each owner. Then the table is exported using the transferspreadsheet method. When the process has finished the tables are deleted. Do to the size of the main table the database grows enormously in sze everytime the procedure is run. Is the anyway I can select the data in code and export my results without having to create a actual table. See attached my code.

Any help is apprciated

Public Function funSplitComData() As Variant
'*******************************************
'Name: funSplitComData (Function)
'Purpose:
'Author: Mcgrco
'Date: October 14, 2002, 12:44:42 PM
'Called by:
'Calls:
'Inputs:
'Output:
'*******************************************
'On Error GoTo ErrHandler
Const MainTable As String = "fees & commissions sap data"
Const Folderpath As String = "cadproj\DAILYREP\Output\CommissionData"
Const Server As String = "S:\"
Const Slash As String = "\"
Const QUOTE As String = """"
Dim strSql, strSqlBac, strSql1 As String
Dim rstBac As Recordset
Dim db As Database
Dim fld As Field
Dim strBACName As String
Dim NewFolder As String
Dim OutputPath As String
Dim ExpY As Integer
Set db = CurrentDb

DoCmd.Hourglass True
OutputPath = Server & Folderpath & Slash

strSqlBac = strSqlBac & " "
strSqlBac = strSqlBac & " SELECT [fees & commissions sap data].BAC"
strSqlBac = strSqlBac & " FROM [fees & commissions sap data]"
strSqlBac = strSqlBac & " GROUP BY [fees & commissions sap data].BAC;"

Set rstBac = db.OpenRecordset(strSqlBac)

DeleteTablesComm

Do While Not rstBac.EOF
For Each fld In rstBac.Fields

strBACName = IIf(IsNull(fld.Value) = True, "", fld.Value)

strSql = strSql & " "
strSql = strSql & " SELECT [fees & commissions sap data].* "
strSql = strSql & " INTO [Comm_Sap_" & strBACName & "]"
strSql = strSql & " FROM [fees & commissions sap data]"
strSql = strSql & " WHERE [fees & commissions sap data].BAC="
strSql = strSql & QUOTE & strBACName & QUOTE
db.Execute (strSql)
strSql = ""

strSql1 = strSql1 & " SELECT Sum([Comm_Sap_" & strBACName & "].[September £'000]) AS [Commission Total £'000]"
strSql1 = strSql1 & " INTO [Comm_Sap_Sum" & strBACName & "]"
strSql1 = strSql1 & " FROM [Comm_Sap_" & strBACName & "]; "
db.Execute (strSql1)
strSql1 = ""

ExpY = DCount("[Group Account Number]", "Comm_Sap_" & strBACName)
DoCmd.TransferSpreadsheet acExport, 8, "Comm_Sap_" & strBACName, OutputPath & "CommData_" & strBACName & ".xls", True, "CommDetail"
DoCmd.TransferSpreadsheet acExport, 8, "Comm_Sap_Sum" & strBACName, OutputPath & "CommData_" & strBACName & ".xls", True, "CommDetail!M" & ExpY + 3 & ":N" & ExpY + 6

Next
rstBac.MoveNext
Loop

DeleteTablesComm

DoCmd.Hourglass False


ExitHere:
Exit Function
ErrHandler:
DeleteTablesComm

DoCmd.Hourglass False
Dim strErrString As String
strErrString = "Error Information..." & vbCrLf
strErrString = strErrString & "Error#: " & err.Number
strErrString = strErrString & "Description: " & err.description
MsgBox strErrString, vbCritical + vbOKOnly, "Function: funSplitComData"
Resume ExitHere
End Function