************************************************************ * FUNCTION CheckXLSHeaders() ************************************************************ * Author............: VCS Developers Team * Project...........: Visual Collections System * Created...........: 01/01/2000 17:00:00 * Copyright.........: (c) Jzanus, 2006 *) Description.......: Checks if all columns are present in Excel file * Calling Samples...: CheckXLSHeaders(getfile('XLS'),"STATUS;BATCH #",3) * Parameter List....: tcInputFile, tcTestString, tnStartFromRow * Major change list.: function CheckXLSHeaders lparameters tcInputFile, tcTestString, tnStartFromRow if empty(m.tcInputFile) return endif local OleApp, lcMsg, lcCellValue, lcStr, lcRange, ; lnCols, lnNumSheets, lnDoneSheets, lnI, loSheet, ; loErr, lnSheet 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 lnCols = .UsedRange.columns.count *-- Create column name array local array laFieldNames[m.lnCols], laTestVals[1] for lnI = 1 to m.lnCols lcCellValue = .Cells(1,m.lnI).value laFieldNames[m.lnI] = upper(alltrim(m.lcCellValue)) next lnCols = alines(laTestVals, m.tcTestString, 1, ";") for lnI = 1 to m.lnCols if ascan(laFieldNames, laTestVals[m.lnI],1,-1,1,5) = 0 lcMsg = laTestVals[m.lnI] + ; " column is not found in " + m.tcInputFile exit endif next endif endwith next OleApp.DisplayAlerts = .f. OleApp.quit catch to loErr lcMsg = Log_Error(m.loErr) endtry OleApp = null return m.lcMsg endfunc ************************************************************ * 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, tlCreateStructure * Major change list.: function fSplitIntoDBF lparameters tcInputFile, tnStartFromRow, tcDbfFile, tlCreateStructure 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, lcStructureDBF 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 lnCols = m.lnFinalCols *-- Create column name array local array laFieldNames[m.lnCols,3], laTestNames[1] local lnFldLen 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) if vartype(laTestNames[1]) = "C" && array was already populated if ascan(laTestNames, laFieldNames[m.lnI,1]) > 0 && This field already exists, let's add a number at the and laFieldNames[m.lnI,1] = laFieldNames[m.lnI,1] + transform(m.lnI) 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] if .range(chr(64 + m.lnI) + ":" + chr(64 + m.lnI)).columns.columnwidth < 50 .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 endif 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 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 catch to loErr lcMsg = Log_Error(m.loErr) finally if vartype(m.OleApp) = 'O' OleApp.DisplayAlerts = .f. && we don't want a question asked OleApp.quit endif 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>hi,
>thisform.text1.value=GETFILE('xls') >IMPORT FROM (thisform.text1.value) TYPE XLS >>this can be automated (Automation from VFP)&& no idea how i can do it?
>CREATE TABLE test >( Clint_no n(15) ,name C(80) nocp, Tel C(10) nocp,category C(20)nocp, entity n(4) ,part2 c(2) nocp,dat d(8) ) >APPEND FROM (thisform.text1.Value) TYPE xl5 >>thanks.
>>>IMPORT FROM (thisform.text1.value) TYPE XLS >>>>>>