FUNCTION fSplitIntoDBF LPARAMETERS tcInputFile, tnStartFromRow, tcDbfFile, tlCreateStructure, tcPassword IF EMPTY(m.tcInputFile) tcInputFile = GETFILE('xls','Select XLS', 'Select', 0, 'Select XLS to create DBF from') IF EMPTY(m.tcInputFile) RETURN "Input file is not passed" ENDIF ENDIF IF EMPTY(m.tcPassword) tcPassword = "" ELSE tcPassword = UPPER(m.tcPassword) ENDIF LOCAL loExcel, lcMsg, lcCellValue, lcStr, lcRange, ; lnRow, lnCol, lnNumSheets, lnDoneSheets, lni, loSheet, ; lnRows, lnCols, llValFound, loErr, ; lnSameField, lnK, lnSheet, lnFinalRows, ; lnFinalCols, lcStructureDBF, lnFldLen, lcColLetter, lnK, loRange LOCAL ARRAY laFieldNames[1,3], laTestNames[1] lcMsg = "" lcCellValue = "" lnDoneSheets = 0 IF EMPTY(m.tnStartFromRow) tnStartFromRow = 1 ENDIF TRY loExcel = CREATEOBJECT("Excel.Application") *-- Open XLS File loExcel.DisplayAlerts = .F. loExcel.APPLICATION.WorkBooks.OPEN(m.tcInputFile,,,,m.tcPassword) lnNumSheets = loExcel.APPLICATION.APPLICATION.WorkBooks(1).Sheets.COUNT FOR lnSheet = 1 TO m.lnNumSheets *-- Select individual sheet from opened XLS File loSheet = loExcel.APPLICATION.APPLICATION.WorkBooks(1).Sheets(m.lnSheet) WITH loSheet .SELECT lcStr = loExcel.APPLICATION.ActiveSheet.NAME ** Do this only for non-SUMMARY sheets in the spreadsheet IF !("SUMMARY" $ UPPER(m.lcStr)) lnDoneSheets = m.lnDoneSheets + 1 ** Delete first N unused rows (help by Sergey Berezniker) IF m.tnStartFromRow > 1 .RANGE("A1" , "A" + TRANSFORM(m.tnStartFromRow)).EntireRow.DELETE() ENDIF *-- Find total # of columns and rows lnCols = .UsedRange.COLUMNS.COUNT lnFinalCols = m.lnCols lnRows = .UsedRange.ROWS.COUNT lnFinalRows = m.lnRows *-- Find total # of really used rows FOR lnRow = m.lnRows TO 1 STEP -1 llValFound = .F. FOR lnCol = m.lnCols TO 1 STEP -1 lcCellValue = .Cells(m.lnRow,m.lnCol).VALUE IF NOT (EMPTY(m.lcCellValue) OR ISNULL(m.lcCellValue)) llValFound = .T. EXIT ENDIF NEXT IF !m.llValFound .ROWS(m.lnRow).DELETE() lnFinalRows = m.lnFinalRows - 1 ENDIF NEXT lnRows = m.lnFinalRows &&.UsedRange.rows.count *-- Find total # of really used columns FOR lnCol = m.lnCols TO 1 STEP -1 llValFound = .F. FOR lnRow = m.lnRows TO 1 STEP -1 lcCellValue = .Cells(m.lnRow,m.lnCol).VALUE IF NOT (EMPTY(m.lcCellValue) OR ISNULL(m.lcCellValue)) llValFound = .T. EXIT ENDIF NEXT IF NOT m.llValFound .COLUMNS(m.lnCols).DELETE() lnFinalCols = m.lnFinalCols - 1 ENDIF NEXT lnRows = m.lnFinalRows lnCols = MIN(m.lnFinalCols, 254) && table limitation lcRange = "A1:" ** Code from Sergey Berezniker lcColLetter = IIF(m.lnCols > 26, CHR(INT((m.lnCols - 1) / 26) + 64), "") + ; CHR(((m.lnCols - 1) % 26) + 65) lcRange = m.lcRange + m.lcColLetter + ALLTRIM(STR(m.lnRows)) .RANGE(m.lcRange).SELECT loExcel.SELECTION.EntireColumn.HIDDEN = .F. && Unhide all hidden columns DIMENSION laFieldNames[m.lnCols, 3] lnK = 0 *-- Create column name array FOR lni = 1 TO m.lnCols lcCellValue = .Cells(1,m.lni).VALUE IF VARTYPE(m.lcCellValue) <> "C" IF VARTYPE(m.lcCellValue) = "N" lcCellValue = "_"+ ALLTRIM(STR(m.lcCellValue)) ELSE lcCellValue = "Not Valid" ENDIF ELSE lcCellValue = PROPER(STRTRAN(m.lcCellValue, CHR(10)," ")) ENDIF laFieldNames[m.lnI,1] = fGetFieldName(m.lcCellValue) IF VARTYPE(laTestNames[1]) = "C" && array was already populated IF ASCAN(laTestNames, laFieldNames[m.lnI,1]) > 0 * This field already exists, lets add a number at the end lnK = m.lnK + 1 laFieldNames[m.lnI,1] = laFieldNames[m.lnI,1] + TRANSFORM(m.lnK) lnFldLen = LEN(laFieldNames[m.lnI,1]) IF m.lnFldLen > 10 laFieldNames[m.lnI,1] = RIGHT(laFieldNames[m.lnI,1],10) ENDIF ENDIF ENDIF DIMENSION laTestNames[m.lnI] laTestNames[m.lnI] = laFieldNames[m.lnI,1] laFieldNames[m.lnI,2] = ALLTRIM(m.lcCellValue) laFieldNames[m.lnI,3] = m.lni NEXT IF EMPTY(m.tcDbfFile) lcStr = STRTRAN(m.lcStr,SPACE(1),"_") lcStr = STRTRAN(m.lcStr,".","_") lcStr = UPPER(STRTRAN(UPPER(JUSTFNAME(m.tcInputFile)),".XLS","") + ; "(" + m.lcStr + ")") tcDbfFile = SYS(5) - CURDIR()- m.lcStr ENDIF IF m.tlCreateStructure lcStructureDBF = ADDBS(JUSTPATH(m.tcDbfFile)) + 'XLSStructure' SELECT 0 CREATE TABLE (m.lcStructureDBF) FREE ; (cShortName C(10), cLongName C(100), iSeq i) INDEX ON UPPER(cLongName) TAG cLongName APPEND FROM ARRAY laFieldNames USE && Close the structure table ENDIF ** Assign new column names to the first row FOR lni = 1 TO m.lnCols .Cells(1,laFieldNames[m.lnI,3]).VALUE = laFieldNames[m.lnI,1] .COLUMNS[m.lnI].EntireColumn.AUTOFIT() *!* if ' date ' $ " " + lower(laFieldNames[m.lnI,2]) + " " && date field *!* loRange = .UsedRange.Offset(2) && we don't want to apply format for header row *!* loRange.columns[m.lnI].NumberFormat = "mm/dd/yyyy" *!* endif TRY ** To make sure long descriptions fit IF .COLUMNS[m.lnI].COLUMNWIDTH > 15 .COLUMNS[m.lnI].COLUMNWIDTH = 240 ELSE .COLUMNS[m.lnI].COLUMNWIDTH = 15 ENDIF CATCH TO loRangeProblem * Let's ignore this error with the range and column width lcMsg = Log_Error(m.loRangeProblem) ENDTRY NEXT *#DEFINE xlDBF3 8 *#DEFINE xlDBF4 11 loExcel.ActiveWorkbook.SAVEAS(m.tcDbfFile, 11) ENDIF ENDWITH NEXT IF (m.lnDoneSheets = 0) lcMsg = "There are no non-summary sheets in the " + ; JUSTFNAME(m.tcInputFile) + " file - cannot process." ELSE IF (m.lnDoneSheets > 1) lcMsg = "There are too many sheets in the " + ; JUSTFNAME(m.tcInputFile) + " file - cannot determine which one to use." ENDIF ENDIF CATCH TO loErr lcMsg = Log_Error(m.loErr) FINALLY IF VARTYPE(m.loExcel) = 'O' loExcel.QUIT loExcel = NULL ENDIF ENDTRY RETURN m.lcMsg ENDFUNC ************************************************************ * FUNCTION fGetFieldName() ************************************************************ FUNCTION fGetFieldName LPARAMETERS tcName LOCAL lcStr, lcAllowedChars, lcFind lcStr = ALLTRIM(m.tcName) lcAllowedChars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' + LOWER('ABCDEFGHIJKLMNOPQRSTUVWXYZ') + "_0123456789" lcFind = CHRTRAN(m.lcStr, m.lcAllowedChars, SPACE(7)) IF LEN(m.lcFind) > 0 lcStr = CHRTRAN(m.lcStr, m.lcFind,REPLICATE("_",LEN(m.lcFind))) ENDIF lcStr = LEFT(ALLTRIM(m.lcStr), 8) IF ASC(LEFT(m.lcStr,1)) >= ASC("0") AND ASC(LEFT(m.lcStr,1)) <= ASC("9") lcStr = "_"+ m.lcStr ENDIF RETURN m.lcStr ENDFUNC