Using CopyFromRecordset to copy to an EXCEL spreadsheet

[HEX]

Hi,
I am using the CopyFromRecordset method to copy from a recordset to an excel spreadsheet. See code below:

The problem I am facing is that for every new sheet, it starts copying from the beginning of the recordset! Can anyone help me with this?
Thanks,
Hex

Do
    oSheet.Range(rangeCell).CopyFromRecordset rs, 65500
    rs.Move 65500
    If rs.EOF = True Then
        Exit Do
    End If
    subLogCommand "We're at: " & rs.AbsolutePosition
    
    With oSheet.Range("a1").Resize(1, rs.Fields.Count)
        .EntireColumn.AutoFit
        '.EntireColumn.WrapText = True
    End With
    sheetnum = sheetnum + 1
    oBook.Worksheets.Add
        Set oSheet = oBook.Worksheets("Sheet" & sheetnum)
    oSheet.Activate
    Call excelHeader(xlsRowNum, hdgCriteria, oSheet)
Loop

[Ephesians]

Probably a bit of overkill but this should give you some useful tips for working with excel sheets from Access:

Public Sub ExportDailies()
'_______________________________________________________________
'Create the Daily Fee Calculation Report in Excel, preformatted by running
'these four make-table queries and the following code which manipulates
'the excel object in memory before storing the file.
'_______________________________________________________________
Dim Questions, message
Dim CalcCore As Recordset, CCCount As Recordset, CCTotals As Recordset
Dim CalcEnhance As Recordset, CECount As Recordset, CETotals As Recordset
Dim QCCore As Recordset, QCCCount As Recordset, QCCTotals As Recordset
Dim QCEnhance As Recordset, QCECount As Recordset, QCETotals As Recordset
Dim ForLoop As Integer
Dim fromdate As Date, todate As Date
Dim sei As SHELLEXECUTEINFO
Dim retval As Long
Set Dbase = CurrentDb
DoCmd.SetWarnings False
DoCmd.OpenQuery "qryDailyCalculation - Core Fees (SD)", acViewNormal
DoCmd.OpenQuery "qryDailyCalculation - Enhanced Fees (SD)", acViewNormal
DoCmd.OpenQuery "qryDailyCalculation - QC Core (SD)", acViewNormal
DoCmd.OpenQuery "qryDailyCalculation - QC Enhanced (SD)", acViewNormal
DoCmd.SetWarnings True
retval = SetForegroundWindow(DailyHwnd)
If GeneralFromDate = GeneralToDate Then
Questions = Format(GeneralFromDate, "mmmm dd")
Else
Questions = Format(GeneralFromDate, "mmmm dd") & " to " & Format(GeneralToDate, "mmmm dd")
End If
Set CalcCore = Dbase.OpenRecordset("tblDailyCalculation - Core Fees", dbOpenSnapshot)
Set CCCount = Dbase.OpenRecordset("SELECT Count([tblDailyCalculation - Core Fees].AC) AS CountOfAC FROM [tblDailyCalculation - Core Fees];")
Set CCTotals = Dbase.OpenRecordset("SELECT Sum([tblDailyCalculation - Core Fees].Core) AS SumOfCore, Sum([tblDailyCalculation - Core Fees].Enhance) AS SumOfEnhance, Sum([tblDailyCalculation - Core Fees].Total) AS SumOfTotal FROM [tblDailyCalculation - Core Fees];")
Set CalcEnhance = Dbase.OpenRecordset("tblDailyCalculation - Enhanced Fees", dbOpenSnapshot)
Set CECount = Dbase.OpenRecordset("SELECT Count([tblDailyCalculation - enhanced fees].AC) AS CountOfAC FROM [tblDailyCalculation - enhanced fees];")
Set CETotals = Dbase.OpenRecordset("SELECT Sum([tblDailyCalculation - enhanced fees].Core) AS SumOfCore, Sum([tblDailyCalculation - enhanced fees].Enhance) AS SumOfEnhance, Sum([tblDailyCalculation - enhanced fees].Total) AS SumOfTotal FROM [tblDailyCalculation - enhanced fees];")
Set QCCore = Dbase.OpenRecordset("tblDailyCalculation - QC Core", dbOpenSnapshot)
Set QCCCount = Dbase.OpenRecordset("SELECT Count([tbldailycalculation - qc core].AC) AS CountOfAC FROM [tbldailycalculation - qc core];")
Set QCCTotals = Dbase.OpenRecordset("SELECT Sum([tbldailycalculation - qc core].Core) AS SumOfCore, Sum([tbldailycalculation - qc core].Enhance) AS SumOfEnhance, Sum([tbldailycalculation - qc core].Total) AS SumOfTotal FROM [tbldailycalculation - qc core];")
Set QCEnhance = Dbase.OpenRecordset("tblDailyCalculation - QC Enhanced", dbOpenSnapshot)
Set QCECount = Dbase.OpenRecordset("SELECT Count([tbldailycalculation - qc enhanced].AC) AS CountOfAC FROM [tbldailycalculation - qc enhanced];")
Set QCETotals = Dbase.OpenRecordset("SELECT Sum([tbldailycalculation - qc enhanced].Core) AS SumOfCore, Sum([tbldailycalculation - qc enhanced].Enhance) AS SumOfEnhance, Sum([tbldailycalculation - qc enhanced].Total) AS SumOfTotal FROM [tbldailycalculation - qc enhanced];")
Dim xls As Excel.Application
Dim xlBook As Excel.Workbook
Set xls = New Excel.Application
Set xlBook = xls.Workbooks.Add
xlBook.Worksheets.Add.Move After:=xlBook.Worksheets(3)
xlBook.Worksheets(1).Range("A5").CopyFromRecordset CalcCore
xlBook.Worksheets(2).Range("A5").CopyFromRecordset CalcEnhance
xlBook.Worksheets(3).Range("A5").CopyFromRecordset QCCore
xlBook.Worksheets(4).Range("A5").CopyFromRecordset QCEnhance
     For ForLoop = 1 To 4
     xlBook.Worksheets(ForLoop).Select
     xlBook.Worksheets(ForLoop).Range("a4") = "AC"
     xlBook.Worksheets(ForLoop).Range("B4") = "AC NAME"
     xlBook.Worksheets(ForLoop).Range("c4") = "CORE"
     xlBook.Worksheets(ForLoop).Range("d4") = "ENHANCED"
     xlBook.Worksheets(ForLoop).Range("e4") = "TOTAL"
     If ForLoop = 1 Then
          xlBook.Worksheets(ForLoop).Range("a2") = CCCount!countofac
          xlBook.Worksheets(ForLoop).Range("c2") = CCTotals!sumofcore
          xlBook.Worksheets(ForLoop).Range("d2") = CCTotals!sumofenhance
          xlBook.Worksheets(ForLoop).Range("e2") = CCTotals!sumoftotal
          xlBook.Worksheets(ForLoop).Range("A1") = "CALCULATION CORE - " & Questions
     ElseIf ForLoop = 2 Then
          xlBook.Worksheets(ForLoop).Range("a2") = CECount!countofac
          xlBook.Worksheets(ForLoop).Range("c2") = CETotals!sumofcore
          xlBook.Worksheets(ForLoop).Range("d2") = CETotals!sumofenhance
          xlBook.Worksheets(ForLoop).Range("e2") = CETotals!sumoftotal
          xlBook.Worksheets(ForLoop).Range("A1") = "CALCULATION ENHANCED - " & Questions
    ElseIf ForLoop = 3 Then
          xlBook.Worksheets(ForLoop).Range("a2") = QCCCount!countofac
          xlBook.Worksheets(ForLoop).Range("c2") = QCCTotals!sumofcore
          xlBook.Worksheets(ForLoop).Range("d2") = QCCTotals!sumofenhance
          xlBook.Worksheets(ForLoop).Range("e2") = QCCTotals!sumoftotal
          xlBook.Worksheets(ForLoop).Range("A1") = "QC CORE - " & Questions
    ElseIf ForLoop = 4 Then
          xlBook.Worksheets(ForLoop).Range("a2") = QCECount!countofac
          xlBook.Worksheets(ForLoop).Range("c2") = QCETotals!sumofcore
          xlBook.Worksheets(ForLoop).Range("d2") = QCETotals!sumofenhance
          xlBook.Worksheets(ForLoop).Range("e2") = QCETotals!sumoftotal
          xlBook.Worksheets(ForLoop).Range("A1") = "QC ENHANCED - " & Questions
    End If
     xlBook.Worksheets(ForLoop).Application.Columns("C:E").NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
     xlBook.Worksheets(ForLoop).Application.Rows("4:4").HorizontalAlignment = xlCenter
     xlBook.Worksheets(ForLoop).Application.Range("A1").Font.Name = "Times New Roman"
     xlBook.Worksheets(ForLoop).Application.Range("A1").Font.Size = 16
     xlBook.Worksheets(ForLoop).Application.Range("A1").Font.Bold = True
     xlBook.Worksheets(ForLoop).Application.Range("A1:E1").HorizontalAlignment = xlCenter
     xlBook.Worksheets(ForLoop).Application.Range("A1:E1").Merge
     xlBook.Worksheets(ForLoop).Application.Range("A3").Select
     xlBook.Worksheets(ForLoop).Application.ActiveWindow.FreezePanes = True
     xlBook.Worksheets(ForLoop).Application.Columns("A:E").EntireColumn.AutoFit
    Next
xlBook.Worksheets.Application.Sheets("sheet1").Select
xlBook.SaveAs "S:\Tech Support\Support Forms\Daily Fee Calculations\" & Questions & " Daily Fee Calculations.xls"
xlBook.Close False
xls.Quit
Set xlBook = Nothing
Set xls = Nothing
retval = SetForegroundWindow(DailyHwnd)
message = MsgBox("The report is finished and is located at:" & vbCr _
                              & "S:\Tech Support\Support Forms\Daily Fee Calculations\" & vbCr _
                              & "and is called " & Questions & " Daily Fee Calculations.xls", vbInformation, "Task Completed")
message = MsgBox("Do you wish to open this file now?", vbYesNo, "Open File")
If message = vbYes Then
     With sei
          .cbSize = Len(sei)
          .fMask = SEE_MASK_NOCLOSEPROCESS
          .hWnd = Application.hWndAccessApp
          .lpVerb = "open"
          .lpFile = "S:\Tech Support\Support Forms\Daily Fee Calculations\" & Questions & " Daily Fee Calculations.xls"
          .lpParameters = ""
          .lpDirectory = "h:\Document\"
          .nShow = SW_SHOWNORMAL
     End With
     retval = ShellExecuteEx(sei)
End If
End Sub