Hi everybody,

I'm using custom function to convert Excel file into DBF. Bellow is the code of this function. Mohammed sent me an Excel file with text in arabic in one of the columns. When I converted it into DBF, Arabic characters became ???

What should I do to make dbf respect different codepage and how can I make my function generic enough to handle conversion automatically?

Appreciate your response very much.

Thanks in advance.

************************************************************
*  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)
	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

*#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, lnFldLen

local array laFieldNames[1,3], laTestNames[1]

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

				dimension laFieldNames[m.lnCols, 3]	
*-- 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
					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

				try
					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
				catch to loRangeProblem
* Let's ignore this error
				endtry
				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, 8)
			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("Long Field Name")
*  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
************************************************************
*  FUNCTION Log_Error()
************************************************************
*  Author............: VCS  Developers Team
*  Project...........: Visual Collections System
*  Created...........: 01/27/2006  12:15:15
*  Copyright.........: (c) Jzanus, 2006
*) Description.......:
*  Calling Samples...:
*  Parameter List....:
*  Major change list.:

function Log_Error
lparameters toError
local lcError, lcVars

lcError = [Error: ] + transform(m.toError.errorno) + chr(13) + chr(10) + ;
	[LineNo: ] + transform(m.toError.lineno) + chr(13) + chr(10) +  ;
	[Message: ] + m.toError.message  + chr(13) + chr(10) +  ;
	[Procedure: ] + m.toError.procedure + chr(13) + chr(10) +  ;
	[Details: ] + m.toError.details  + chr(13) + chr(10) + ;
	[StackLevel: ] + transform(m.toError.stacklevel) + chr(13) + chr(10) + ;
	[LineContents: ] + m.toError.linecontents
*lcVars = GetLocalVars() JMW Unnessary
*!*	lcError = m.lcError + + CHR(13) + CHR(10) + ;
*!*		'Local Variables defined : ' + m.lcVars
*!*	_CLIPTEXT = m.lcError

return m.lcError