************************************************************ * FUNCTION fSplitIntoDBF() ************************************************************ * Author............: VCS Developers Team * Project...........: Visual Collections System * Created...........: 01/01/2000 17:00:00 * Copyright.........: (c) Jzanus, 2006 *) Description.......: Takes an Excel file and makes a DBF out of it * Calling Samples...: fSplitIntoDBF(getfile('XLS') * Parameter List....: tcInputFile, tnStartFromRow, tcDbfFile * Major change list.: function fSplitIntoDBF lparameters tcInputFile, tnStartFromRow, tcDbfFile, taFieldNames external array taFieldNames if type('taFieldNames[1]') = 'U' release taFieldNames local array taFieldNames[1] endif if empty(m.tcInputFile) return endif #include Excel.h local OleApp, lcMsg, lcCellValue, lcStr, lcRange, ; lnRow, lnCol, lnNumSheets, lnDoneSheets, lnI, loSheet, ; lnRows, lnCols, llValFound, loErr, ; lnSameField, lnK, lnSheet, lnFinalRows, lnFinalCols lcMsg = "" lcCellValue = "" lnDoneSheets = 0 if empty(m.tnStartFromRow) tnStartFromRow = 1 endif try OleApp = createobject("Excel.Application") *-- Open XLS File OleApp.application.WorkBooks.open(m.tcInputFile) lnNumSheets = OleApp.application.application.WorkBooks(1).Sheets.count for lnSheet = 1 to m.lnNumSheets *-- Select individual sheet from opened XLS File loSheet = OleApp.application.application.WorkBooks(1).Sheets(m.lnSheet) with loSheet .select lcStr = OleApp.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 lnCols = .UsedRange.columns.count lnFinalCols = m.lnCols lnRows = .UsedRange.rows.count lnFinalRows = m.lnRows *-- Find total # of 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 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 !llValFound .Columns(m.lnCols).delete() lnFinalCols = m.lnFinalCols - 1 endif next lnRows = m.lnFinalRows &&.UsedRange.rows.count lnCols = m.lnFinalCols && .UsedRange.columns.count *-- Create column name array local array laFieldNames[m.lnCols,3] 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 endif laFieldNames[m.lnI,1] = fGetFieldName(m.lcCellValue) laFieldNames[m.lnI,2] = alltrim(m.lcCellValue) laFieldNames[m.lnI,3] = m.lnI next *-- SORT Field Names =asort(laFieldNames,1) lnK = 1 ** Now make sure we don't have duplicates for lnI = 1 to m.lnCols - 1 lnSameField = ascan(laFieldNames, laFieldNames[m.lnI,1], m.lnI + 1,-1,1,8+2) if m.lnSameField > 0 laFieldNames[m.lnSameField,1] = ; laFieldNames[m.lnSameField,1] + transform(m.lnK) lnK = m.lnK + 1 endif endfor acopy(laFieldNames, taFieldNames) && So we can pass an array by reference ** 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] .Range(chr(64 + m.lnI) + ":" + chr(64 + m.lnI)).Columns.ColumnWidth = ; .Range(chr(64 + m.lnI) + ":" + chr(64 + m.lnI)).Columns.ColumnWidth * 5 && To make sure long descriptions fit next lcRange = "A1:" lcRange = m.lcRange + chr(64 + m.lnCols) + alltrim(str(m.lnRows)) .range(m.lcRange).select * .Range("A:Z").EntireColumn.AutoFit() - doesn't work for long fields 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 OleApp.DisplayAlerts = .f. *#DEFINE xlDBF3 8 OleApp.ActiveWorkbook.saveas(m.tcDbfFile, xlDBF3) endif endwith next if (m.lnDoneSheets = 0) lcMsg = "There are no non-summary sheets in the file - cannot process." else if (m.lnDoneSheets > 1) lcMsg = "There are too many sheets in the file - cannot determine which to use." endif endif OleApp.quit catch to loErr lcMsg = Log_Error(m.loErr) endtry OleApp = null return m.lcMsg endfunc ************************************************************ * FUNCTION fGetFieldName() ************************************************************ * Author............: VCS Developers Team * Project...........: Visual Collections System * Created...........: 01/01/2000 17:00:00 * Copyright.........: (c) Jzanus, 2006 *) Description.......: Attempts to make a field name string * Calling Samples...: fGetFieldName() * Parameter List....: tcName * Major change list.: function fGetFieldName lparameters tcName lcStr = alltrim(tcName) lcAllowedChars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'+lower('ABCDEFGHIJKLMNOPQRSTUVWXYZ') + "_"+"0123456789" lcFind = chrtran(lcStr,lcAllowedChars,space(7)) if len(lcFind) > 0 lcStr =chrtran(lcStr,lcFind,replicate("_",len(lcFind))) endif lcStr = left(alltrim(lcStr),8) if asc(left(lcStr,1)) >= asc("0") and asc(left(lcStr,1)) <= asc("9") lcStr = "_"+ lcStr endif return lcStr endfunc *=======================================================================