>loExcel = CREATEOBJECT("Excel.Application") >loExcel.Workbooks.Open("Somefile.xls") >loExcel.Workbooks.SaveAS("Somefile.dbf",8) && Convert to dbf 3 >loExcel.Workbooks.Close(0) && Close, do not keep changes >loExcel.Quit >>
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