LPARAMETER tcExcelFile *-- check parameters ------------------------------------------------------------------------------ IF VARTYPE(tcExcelFile) <> "C" ??CHR(7) WAIT WINDOW NOWAIT "Parameter <tcExcelFile> : Parameter missing or wrong type (Expecting 'C')" RETURN -1 ENDIF LOCAL lnSelect, lcAlias, lnFields, loXls, loWorkbook, lnCols, lnRows, loTherm, lcStrict LOCAL loRange, i, lnCol, luValue, lcXlsDataType, lcFieldName, lcFoxDataType lnSelect = SELECT() lcAlias = ALIAS() IF EMPTY(lcAlias) ??CHR(7) WAIT WINDOW NOWAIT "No table is open in the current workarea" RETURN -2 ENDIF lnFields = AFIELDS(laFields) loXls = CREATEOBJECT("excel.application") loWorkbook = loXLS.Application.Workbooks.Open(tcExcelFile) loXls.Application.DisplayAlerts = .f. lnCols = loXls.CountA(loXls.ActiveSheet.Range("1:1")) lnRows = loXls.CountA(loXls.ActiveSheet.Range("A:A")) -1 loTherm = NEWOBJECT("therm", "THERM.VCX", "", "Importing Excel Data...") lcStrict = SET("STRICTDATE") SET STRICTDATE TO 0 WITH loXls.activeSheet loRange = .range(.cells(2,1), .cells(2,lnCols)) FOR i = 1 TO lnRows WITH loTherm .lblMessage.caption = "Importing Excel Data - Row " + ALLTRIM(TRANS(i)) + " of " + ALLTRIM(TRANS(lnRows)) .updateStatusBar((i/lnRows) * 100) ENDWITH WITH loRange FOR lnCol = 1 TO lnFields luValue = .Columns[lnCol].value lcXlsDataType = VARTYPE(luValue) lcFieldName = laFields[lnCol, 1] lcFoxDataType = TYPE(lcFieldName) IF lcXlsDataType <> lcFoxDataType *-- convert data luValue = ConvertData(luValue, lcXlsDataType, lcFoxDataType ) ENDIF *-- handle Excel cells that contain null values IF lcXlsDataType = "X" && .NULL. *-- initialize blank memvar SCATTER MEMVAR FIELDS &lcFieldName BLANK ELSE STORE luValue TO ( "m." + lcFieldName ) ENDIF ENDFOR && *lnCol = 1 TO lnFields ENDWITH *-- add record INSERT INTO (lcAlias) FROM MEMVAR *-- move to next row loRange = loRange.Offset(1,0) ENDFOR &&* i = 1 TO lnRows ENDWITH *-- restore environment SET STRICTDATE TO (lcStrict) loXls.Application.quit RETURN RECNO() ************************************************ FUNCTION ConvertData ************************************************ *) Procedure.........: ConvertData * Author............: Daniel Gramunt * Project...........: SAP Tools * Created...........: 13.10.2000 17:09:03 * Copyright.........: (c) 4M Technologies, 2000 *) Description.......: * Calling Samples...: * Parameter List....: * Major change list.: *-------------------------------------------------------------------------------------------------- LPARAMETER tuValue, tcFromDataType, tcToDataType LOCAL luRetVal DO CASE CASE tcFromDataType = "C" DO CASE CASE INLIST(tcToDataType, "N", "Y") luRetVal = VAL(tuValue) CASE tcToDataType = "L" luValue = UPPER(luValue) IF INLIST(tuValue, "YES", "TRUE", "#TRUE#", "Y", "T", ".T.") luRetVal = .t. ELSE luRetVal = .f. ENDIF CASE tcToDataType = "D" luRetVal = CTOD(tuValue) CASE tcToDataType = "T" luRetVal = CTOT(tuValue) OTHERWISE luRetVal = .NULL. ENDCASE CASE INLIST(tcFromDataType, "N", "Y") DO CASE CASE tcToDataType = "C" luRetVal = TRANSFORM(tuValue) CASE tcToDataType = "L" luVale = IIF(luValue = 0, .f., .t.) CASE tcToDataType = "D" luRetVal = {} CASE tcToDataType = "T" luRetVal = {} OTHERWISE luRetVal = .NULL. ENDCASE CASE tcFromDataType = "D" DO CASE CASE tcToDataType = "C" luRetVal = DTOC(tuValue) OTHERWISE luRetVal = .NULL. ENDCASE CASE tcFromDataType = "T" DO CASE CASE tcToDataType = "C" luRetVal = DTOT(tuValue) CASE tcToDataType = "D" luRetVal = tuValue OTHERWISE luRetVal = .NULL. ENDCASE OTHERWISE luRetVal = .NULL. ENDCASE RETURN luRetVal *-- EOF Function ConvertData ---------------------------------------------------------------------->Hi everyone,