Clear all * Create a test cursor Create cursor testcursor (Rcno i,cType c(10), nType i, dType d) Rand(-1) For ix = 1 to 200000 && Create 200000 recs cursor Insert into testcursor values ; (recco()+1,sys(2015), int(rand()*1000), date()-int(rand()*100)) Endfor Set sysformats on Set safety off lnTotal = reccount() Wait window nowait "Pls wait sending data to Excel..." Start = seconds() oExcel = createobject("Excel.application") #Define xlNormal -4143 With oExcel .workbooks.add && Add a new workbook lnMaxRows = .ActiveWorkBook.ActiveSheet.Rows.Count && Get max row count .ActiveWorkBook.Close(.f.) && Close no save lnNeededBooks = ceiling( lnTotal / (lnMaxRows - 1) ) && 1 row header ? "Total Books : "+padr(lnNeededBooks,3," ") For ix = lnNeededBooks to 1 step - 1 && Do a reverse pass so we wouldn't need an extra command to arrange windows lnStart = ( ix - 1 ) * (lnMaxRows-1) + 1 Copy to ("temp"+padl(ix,2,"0")) ; for between(recno(),lnStart,lnStart+lnMaxRows-2) ; type fox2x .workbooks.Open(sys(5)+curdir()+"temp"+padl(ix,2,"0")) .ActiveWindow.WindowState = xlNormal ? "Book no : "+; padl(ix,3," ")+; "/"+; padr(lnNeededBooks,3," ")+ ; " Elapsed : ",seconds() - start Endfor #Define xlTiled 1 .Windows.Arrange(xlTiled) .visible = .t. Endwith ? "Total Elapsed : ",seconds() - startIf you don't like separate workbooks option than you could try inserting into a single workbook (multipl sheets). In this case unfortunately you should take a coffee break ( or fortunately :)
Clear all * Create a test cursor Create cursor testcursor (Rcno i,cType c(10), nType i, dType d) Rand(-1) For ix = 1 to 200000 && Create 200000 recs cursor Insert into testcursor values ; (recco()+1,sys(2015), int(rand()*1000), date()-int(rand()*100)) Endfor Set sysformats on Set safety off lnTotal = reccount() Wait window nowait "Pls wait sending data to Excel..." Start = seconds() oExcel = createobject("Excel.application") With oExcel .workbooks.add && Add a new workbook lnMaxRows = .ActiveWorkBook.ActiveSheet.Rows.Count && Get max row count lnNeededSheets = ceiling( lnTotal / (lnMaxRows - 1) ) && 1 row header ? "Total Pages : "+padr(lnNeededSheets,3," ") With .ActiveWorkBook lnCurrentSheetCount = .sheets.count If lnNeededSheets > lnCurrentSheetCount .sheets.add(,.sheets(lnCurrentSheetCount),; lnNeededSheets - lnCurrentSheetCount) && Add new sheets after old ones Endif For ix = 1 to lnNeededSheets With .sheets.item(ix) .name = "Page "+padl(ix,3,"0") .activate =InsertGroup(ix, lnMaxRows) Endwith Endfor .sheets.item(1).activate Endwith .visible = .t. Endwith ? "Total Elapsed : ",seconds() - start Function InsertGroup Lparameters tnSheetNumber, tnMaxRows Local jx, lnPasteStart, lnPassCount, lnPasteRecco lnPasteStart = ( tnSheetNumber - 1 ) * (tnMaxRows-1) + 1 Copy to temp for between(recno(),lnPasteStart,lnPasteStart+tnMaxRows-2) type fox2x With oExcel .workbooks.Open(sys(5)+curdir()+"temp.dbf") .ActiveWorkBook.ActiveSheet.Cells(1,1).CurrentRegion.Copy .workbooks(1).sheets.Item(tnSheetNumber).Paste() _Cliptext = "" && Empty clipboard .workbooks(2).close(.f.) && Close - no save .workbooks(1).sheets.Item(tnSheetNumber).Cells(1,1).Activate() && remove selection Endwith ? "Page no : "+; padl(tnSheetNumber,3," ")+; "/"+; padr(lnNeededSheets,3," ")+ ; " Elapsed : ",seconds() - startCetin