Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Saveas: do not keep incomp. functions, do not keep chang
Message
 
 
To
24/07/2007 10:06:56
General information
Forum:
Visual FoxPro
Category:
COM/DCOM and OLE Automation
Miscellaneous
Thread ID:
01243150
Message ID:
01243237
Views:
66
This message has been marked as the solution to the initial question of the thread.
>I use Excel by automation, to convert XLS to DBF.
>
>I do:
>
>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
>
>
>This does the job, without user interface, BUT not for all XLS-files. Some of them convert completely, some of them only convert the first 2 or 3 columns.
>
>When I do it manually, so I press SaveAs fom the menu, choose dbf 3, choose Yes (leave incompatible functions out), close the window, choose No, I always get ALL columns.
>
>So, somewhere in the statements above something is missing, telling Excel to convert all columns.
>
>Should I state somewhere the equivalent of "leave incompatible functions out"? How?
>
>TIA
>
>Lennert

You may have empty rows or names with spaces or other problems causing the Excel to not be able to save properly. Also do all these files have only English text in them or there may be some other language text?

My colleague wrote a special a bit complex function to perform Excel to DBF conversion, which I then modified.

I'll post it here, it works in 99% of cases (didn't work for Arabic text, though).
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
If it's not broken, fix it until it is.


My Blog
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform