Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Export to Excel
Message
De
01/03/2000 11:05:01
Cetin Basoz
Engineerica Inc.
Izmir, Turquie
 
Information générale
Forum:
Visual FoxPro
Catégorie:
Codage, syntaxe et commandes
Titre:
Divers
Thread ID:
00339517
Message ID:
00339831
Vues:
20
>I am trying to export a VFP table to and Excel worksheet and am running into a problem in that the resulting XLS file seems to have a limit to the number of rows that can be imported. If I use the following command: COPY TO test XLS the resulting worksheet does not contain all of the table's records. Does anyone know of a solution to this problem?
>
>Thanks in advance for your help.


Hi,
You could get your data to Excel if your users are patient enough to wait VBA code to finish :) There are numerous ways to do it. If your data has no more than 65535 rows (Excel max) it's great. Just save to a fox2x table and open it. Otherwise my best option is to divide original table into smaller (65535 max records) fox2x tables and open each in a "new workbook". To my experience it's the fastest.
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() - start
If 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() - start
Cetin
Çetin Basöz

The way to Go
Flutter - For mobile, web and desktop.
World's most advanced open source relational database.
.Net for foxheads - Blog (main)
FoxSharp - Blog (mirror)
Welcome to FoxyClasses

LinqPad - C#,VB,F#,SQL,eSQL ... scratchpad
Précédent
Répondre
Fil
Voir

Click here to load this message in the networking platform