Write query results to Excel...over 63k records

[Abraxus]

I have been using this code to write out the results of my query to excel:

Code: Select all

Public Function SendTQ2ExcelSheet(strTQName As String, strSheetName As String)
'SendTQ2ExcelSheet "qryForFullVPOutput","VP Detail Data Review"

' 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
   
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Dim strPath As String
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
   
On Error GoTo err_handler
strPath = "\\WinShare\iFile\SCM_HDrive\ContractorCompliance\Potential Contingent Labor_Master Template-BLANK2.xls"
Set rst = CurrentDb.OpenRecordset(strTQName)
Set ApXL = CreateObject("Excel.Application")
    Set xlWBk = ApXL.Workbooks.Open(strPath)
    'ApXL.Visible = True
    ApXL.Visible = False
    ApXL.ScreenUpdating = False
       
    Set xlWSh = xlWBk.Worksheets(strSheetName)
  
    xlWSh.Activate
    xlWSh.Range("A3").Select
 
    'For Each fld In rst.Fields
    '    ApXL.ActiveCell = fld.Name
    '    ApXL.ActiveCell.Offset(0, 1).Select
    'Next
    rst.MoveFirst
 
    xlWSh.Range("A3").CopyFromRecordset rst


    rst.Close
    Set rst = Nothing
    
    
    ApXL.ActiveWorkbook.SaveAs FileName:="\\WinShare\iFile\SCM_HDrive\ContractorCompliance\VPReports\" & Format(Now, "YYYYMMDD") & "\" & Format(Now, "YYYYMMDD") & "-Full 3501 Report.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        
    ApXL.ActiveWorkbook.Close SaveChanges:=False
    'Close the Spreadsheet
    ApXL.Workbooks.Close
    ApXL.Quit
    Set ApXL = Nothing
    
    Set db = Nothing    
    
Exit Function
 
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Exit Function
End Function

It has been working well and very quick, too, until....the results of the query exceeded 65,000 (not an exact number, it's the odd limit old Excel had).

Now my query has over 67,000 and it's only writing out the 65000.

I can go back to my old code that writes out out line by line, but it's SOOOOOOO incredibly slow...I mean over 5 hours slow...

How do I get around that 65000 limit and still make it fast?

[HansV]

That is because the file you are using is a .xls workbook, that is an Excel 97-2003 workbook.
If you save it as an Excel 2007 and later workbook (.xlsx), you should be able to export more than a million rows.

[Abraxus]

I hate when the answer is simple and staring me in the face, but I absolutely appreciate your help!