Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Import from excel to vfp
Message
 
 
To
26/06/2006 02:05:58
General information
Forum:
Visual FoxPro
Category:
Databases,Tables, Views, Indexing and SQL syntax
Environment versions
Visual FoxPro:
VFP 9 SP1
OS:
Windows XP
Database:
Visual FoxPro
Miscellaneous
Thread ID:
01131502
Message ID:
01131678
Views:
18
Hi Mohammed,

Bellow are two functions I've created based on my colleague's code and a help from Sergey Berezniker. The first allows to check, if the particular fields (headers) are present in the Excel. The second allows to create a table from Excel file. The files assume to have first line with the headers and then data. You can have few title lines in the XLS, if this is so, you can pass StartFrom parameter. Hope this helps.
************************************************************
*  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,
>thank you,
>about.. I don't know how to do this with the "import" command ? as..
>
>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?
>
>i can do that as example under...,
>but the number of fields and fields names not the same every time.
>
>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.
>
>>>hi all,
>>>
>>>any idea, help
>>>
>>>when i make import from excel to dbf
>>>
>>>fields name as(no,name, telno,customer no...) change to a,b,c,d...
>>>is ther away to keep the names as it is at dbf
>>>
>>>IMPORT FROM (thisform.text1.value) TYPE XLS
>>>
>>>
>>>thanks
>>
>>I don't know how to do this with the "import" command, but you can open the spreadsheet in Excel and save it in DBF format. Of course, this can be automated (Automation from VFP).
If it's not broken, fix it until it is.


My Blog
Previous
Reply
Map
View

Click here to load this message in the networking platform