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
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?