Export Access query to Excel using a command button on an Access form

[CoolFactor]

MY CODE IS NEAR THE BOTTOM
I want to export this Access query into Excel using a command button on an Access form in the following way I describe below.

Below you will find the simple query I am trying to export to Excel using a command in an Access Form.

RowID strFY AccountID CostElementWBS
1 2008 1 7
2 2008 1 7

I want to export the 1st record of this query to an excel workbook in the following way:

In Workheet "Sheet1," I want the data pertaining to field strFY to go to Cell "A1," and then I want the data pertaining to field AccountID to go to Cell "A2."

Then in Worksheet "Sheet2," I want the data pertaining to field CostElementWBS to go to Cell "B1."

FOR THE SECOND RECORD IN THIS TABLE:

I want to export the 2nd record of this table to a new excel workbook in the following way:

In Workheet "Sheet1," I want the data pertaining to field strFY to go to Cell "A1," and then I want the data pertaining to field AccountID to go to Cell "A2." Then in Worksheet "Sheet2," I want the data pertaining to field CostElementWBS to go to Cell "B1."

Here is my code:

Option Compare Database
Option Explicit
 
Private Sub cmdauto_Click()
On Error GoTo err_Handler
 
   MsgBox ExportRequest, vbInformation, "Finished"
 
exit_Here:
   Exit Sub
err_Handler:
   MsgBox Err.Description, vbCritical, "Error"
   Resume exit_Here
End Sub
 
 
Public Function ExportRequest() As String
   On Error GoTo err_Handler
 
   ' Excel object variables
   Dim appExcel As Excel.Application
   Dim wbk As Excel.Workbook
   Dim wks As Excel.Worksheet
 
   Dim sTemplate As String
   Dim sTempFile As String
   Dim sOutput As String
 
   Dim dbs As DAO.Database
   Dim rst As DAO.Recordset
   Dim sSQL As String
   Dim lRecords As Long
   Dim iRow As Integer
   Dim iCol As Integer
   Dim iFld As Integer
 
   Const cTabOne As Byte = 1
   Const cTabTwo As Byte = 2
   Const cStartRow As Byte = 3
   Const cStartColumn As Byte = 1
 
   DoCmd.Hourglass True
 
   ' set to break on all errors
   Application.SetOption "Error Trapping", 0
 
   ' start with a clean file built from the template file
   sTemplate = CurrentProject.Path & "\Test 1.xls"
 
   ' Create the Excel Applicaiton, Workbook and Worksheet and Database object
   Set appExcel = New Excel.Application
   appExcel.Visible = True
   Set wbk = appExcel.Workbooks.Add(sTemplate)
   Set wks = appExcel.Worksheets(cTabOne)
 
   sSQL = "select * from qry_12"
   Set dbs = CurrentDb
   Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
   If Not rst.BOF Then rst.MoveFirst
 
   ' For this template, the data must be placed on the 4th row, third column.
   ' (these values are set to constants for easy future modifications)
   iCol = cStartColumn
   iRow = cStartRow
 
 
   Do Until rst.EOF
      iFld = 0
      lRecords = lRecords + 1
      Me.Repaint
 
      For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
         wks.Cells(iRow, iCol) = rst.Fields(iFld)
 
         If InStr(1, rst.Fields(iFld).Name, "Date") > 0 Then
            wks.Cells(iRow, iCol).NumberFormat = "mm/dd/yyyy"
         End If
 
         wks.Cells(iRow, iCol).WrapText = False
         iFld = iFld + 1
      Next
 
      wks.Rows(iRow).EntireRow.AutoFit
      iRow = iRow + 1
      rst.MoveNext
   Loop
 
   ExportRequest = "Total of " & lRecords & " rows processed."
 
   ' My users appreciate when I resize the columns to fit the data.
    wks.Cells.Select
    wks.Cells.EntireColumn.AutoFit
 
    ' Set the focus back at the first cell
    wks.Range("A1").Select
 
exit_Here:
   ' Cleanup all objects  (resume next on errors)
   On Error Resume Next
   Set wks = Nothing
   Set wbk = Nothing
   Set appExcel = Nothing
   Set rst = Nothing
   Set dbs = Nothing
   DoCmd.Hourglass False
   Exit Function
 
err_Handler:
   ExportRequest = Err.Description
   Resume exit_Here
 
End Function
 

Also on that command button when I click on it, it executes a function that exports data from a query to an new excel file. That parts works fine but what I want is to click on the button again and hope that it executes the same function but gives the new excel workbook a different name instead of the same name as the first time I clicked on the button.


A step by step process would be much appreciated. I've researching this for a the past 3 days with no luck, so I thank you many times over for your assistance.

Thank you.

[MMcCarthy]

Change your file name to include a timestamp

' start with a clean file built from the template file
sTemplate = CurrentProject.Path & "\Test 1" & Now() & ".xls"