Here's the code:
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| * Program...........: Copy2xls.prg | |
| * Author............: Daniel Gramunt | |
| * Project...........: common | |
| * Created...........: 11.10.2000 17:25:06 | |
| *) Description.......: Replacement for the native COPY TO TYPE XL5 command. | |
| *) : Excel 5 and Excel 95 have a limit of 16,383 rows per worksheet. | |
| *) : The limit in Excel 97 and Excel 2000 is 65,536 rows. | |
| *) : Since there is no TYPE XL8 command, VFP copies only the first 16,383 records. | |
| *) : | |
| *) : This program works around this limitation and allows to copy as many | |
| *) : records as the Excel version used on the user's machine supports. | |
| *) : | |
| *) : The solution is very simple: | |
| *) : 1. COPY TO TYPE CSV | |
| *) : 2. Open CSV file and SaveAs(tcExcelFile) using Automation | |
| *) : | |
| *) : Assumes that MS Excel (Excel 97 or higher) is installed on the | |
| *) : user's machine (well, it will also work with Excel 5.0 and 95, but of | |
| *) : course the limit of 16,383 will apply). | |
| *) : | |
| *) : Returns the number of exported records if successful, otherwise: | |
| *) : -1 = parameter missing or wrong type | |
| *) : -2 = no table open in current workarea | |
| *) : -3 = number of max. Excel rows exceeded | |
| *) : -4 = user didn't want to overwrite existing Excel file (SET SAFETY = ON) | |
| *) : | |
| *) : Performance note: The COPY TO command in VFP works very fast compared to | |
| *) : anything that involves automation. However, since we use | |
| *) : automation only to open the exported file and to save it | |
| *) : under a different format, there is almost no performance | |
| *) : penalty. | |
| *) : | |
| * Calling Samples...: Copy2Xls("c:\temp\bidon.xls") | |
| * Parameter List....: tcExcelFile - Path\Filename of the Excel file to be created. | |
| * : [tlDbf] - Specifies which TYPE to use with the COPY TO command: | |
| * : .t. = TYPE FOX2X | |
| * : .f. = TYPE CSV | |
| * : Default = .f. | |
| * : There are some differences between FOX2X and CSV. Depending on the | |
| * : data to be copied, you can now specify which method to use. | |
| * : See the remarks below for a description of the differences between | |
| * : the two methods. | |
| * : [tlNoFieldNames] - By default, the first row of the Excel sheet contains the | |
| * : fieldnames. If tlNoFieldNames is .t., the Excel sheet contains | |
| * : only the data. | |
| * : | |
| * Major change list.: 26.10.2000: COPY TO FOX2X and SaveAs(< tcExcelFile >) instead of | |
| * : "assembling" individual Excel files. | |
| * : Thanks to an idea from Çetin Basöz on the UT | |
| * : 12.04.2000: COPY TO CSV instead of FOX2X. | |
| * : FOX2X has the following limitations: | |
| * : - problem with codepage 850 (e.g. character "ã") | |
| * : - doesn't support long fieldnames (work around would be easy though) | |
| * : - doesn't support datetime | |
| * : CSV has none of the above problems, but has some other | |
| * : limitations: | |
| * : - logical fields are translated into F/T vs FALSE/TRUE. | |
| * : This isn't a problem, but to keep things consistent, we | |
| * : don't use the native COPY TO TYPE XL5 anymore for tables | |
| * : with a record count below the limitation. | |
| * : - If a character field contains only digits and the value | |
| * : contains leading zeros, Excel translates this into a | |
| * : numeric value (e.g. "00000100" => 100). This could be a | |
| * : problem, specially if the field is a PK and you later | |
| * : import the Excel file back into VFP. | |
| * : - [New 04.06.2001] | |
| * : If a character field contains double quotes and/or commas, | |
| * : the result gets messed-up: | |
| * : | |
| * : - VFP ------------------------------------------ - Excel -------------------------------------------------------------------- - Remarks ----------------------------------- | |
| * : cDesc1 cDesc2 cDesc1 cDesc2 Next Field | |
| * : ------------------------ ----------------------- ----------------------------------------- ----------------------- ---------- --------------------------------------------- | |
| * : Rotating seal 1" Bibus:Deublin model 55 Rotating seal 1",Bibus:Deublin model 55" cDesc2 appended to cDesc1, all other fields | |
| * : are shifted to the left by one | |
| * : | |
| * : Bush 7/16" D=15/4,75 L=86,4 Bush 7/16",D=15/4 75 L=86 4" part of cDesc2 appended to cDesc1 (text until | |
| * : 1st comma), the remaining text until the next | |
| * : comma stays in cDesc2, the text after the | |
| * : second comma is moved to field3, after that, | |
| * : every field is shifted to the right by one | |
| * : | |
| * : 04.06.2001 New parameters < tlDbf > and < tlNoFieldNames > added | |
| *-------------------------------------------------------------------------------------------------- | |
| LPARAMETER tcExcelFile, tlDbf, tlNoFieldNames | |
| #INCLUDE FoxPro.h | |
| #DEFINE xlWorkbookNormal -4143 && used by SaveAs() to save in current Excel version | |
| #DEFINE ccErrorNoParameter "Parameter < tcExcelFile > : Parameter missing or wrong type (Expecting 'C')" | |
| #DEFINE ccErrorNoTableOpen "No table is open in the current workarea" | |
| #DEFINE ccErrorToManyRows "Number of records (" + ; | |
| ALLTRIM(TRANSFORM(lnRecords, "999,999,999")) +; | |
| ") exceed max. number of Excel rows (" -; | |
| ALLTRIM(TRANSFORM(lnXlsMaxNumberOfRows, "999,999,999"))+; | |
| ")" | |
| *-- check parameter | |
| IF VARTYPE(tcExcelFile) <> "C" OR EMPTY(tcExcelFile) | |
| ??CHR(7) | |
| WAIT WINDOW NOWAIT ccErrorNoParameter | |
| RETURN -1 | |
| ELSE | |
| tcExcelFile = ForceExt(tcExcelFile, "XLS") | |
| ENDIF | |
| *-- make sure that we have a table/cursor in the selected workarea | |
| IF EMPTY(ALIAS()) | |
| ??CHR(7) | |
| WAIT WINDOW NOWAIT ccErrorNoTableOpen | |
| RETURN -2 | |
| ENDIF | |
| LOCAL loXls, lnXlsMaxNumberOfRows, lnRecords, lnRetVal, lcTempDbfFile | |
| loXls = CREATEOBJECT("excel.application") | |
| *-- suppress Excel alerts and messages (similar to SET SAFETY OFF) | |
| loXls.DisplayAlerts = .f. | |
| *-- get number of max. rows from Excel. Before we can count the rows in a | |
| *-- worksheet, we need to add a workbook. | |
| loXls.workbooks.add() | |
| lnXlsMaxNumberOfRows = loXls.ActiveWorkBook.ActiveSheet.Rows.Count - 1 && 1 header row | |
| lnRecords = RECCOUNT() | |
| *-- check if the number or records exceeds Excel's limit | |
| IF lnRecords > lnXlsMaxNumberOfRows | |
| ??CHR(7) | |
| WAIT WINDOW NOWAIT ccErrorToManyRows | |
| *-- close Excel | |
| loXls.application.quit() | |
| RETURN -3 | |
| ENDIF | |
| *-- respect SET SAFETY | |
| IF SET("SAFETY") = "ON" AND FILE(tcExcelFile) | |
| IF MESSAGEBOX(tcExcelFile + " already exists, overwrite it?",; | |
| MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = IDNO | |
| *-- user selected < No > so we bail out | |
| *-- close Excel | |
| loXls.application.quit() | |
| RETURN -4 | |
| ENDIF | |
| ENDIF | |
| IF tlDbf | |
| lcTempDbfFile = AddBs(SYS(2023)) + SYS(3) + ".DBF" | |
| COPY TO (lcTempDbfFile) TYPE FOX2X AS 850 | |
| ELSE | |
| lcTempDbfFile = AddBs(SYS(2023)) + SYS(3) + ".CSV" | |
| COPY TO (lcTempDbfFile) TYPE CSV | |
| ENDIF | |
| lnRetVal = _TALLY | |
| *-- open exported CSV file | |
| loXls.Application.Workbooks.Open(lcTempDbfFile) | |
| IF tlNoFieldNames | |
| loXls.ActiveSheet.Range("1:1").delete | |
| ENDIF | |
| *-- save as Excel file | |
| loXls.ActiveSheet.saveAs(tcExcelFile, xlWorkbookNormal) | |
| *-- delete CSV file | |
| IF FILE(lcTempDbfFile) | |
| DELETE FILE (lcTempDbfFile) | |
| ENDIF | |
| *-- close Excel | |
| loXls.application.quit() | |
| RETURN lnRetVal |
Komentar