hi,
thank you for reply,
i try your code before , it works, but with one problem
i have field (arabic data), i see it as rubbish (remmeber),
via Mr.Sergey Berezniker code i can solve this problem(arabic fields)
thanks alot
m.qasem
>>hi,
>>yes this is the problem, but always i need to import any excel sheet have
>>fields (more 10 characters or (-,;'...etc)
>>
>>thank you.
>
>Try this function:
>
>************************************************************
>* 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, 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
> 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
>
>*-- 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 = min(m.lnFinalCols, 254)
> 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.
>
> 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"
> 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
> 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]) + " "
>*!* loRange = .UsedRange.Offset(2)
>*!* 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()
>************************************************************
>* 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
>
>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
>
