IMPORT EXCEL FILE TO DBF

[swapan]

Dear All:

Has any1 or do we have any UDF/routine/tool in HMG to convert an excel file to dbf?
Looking for a source, so that I can change the coding to fit my requirement -viz. Starting row no. (keeping header), 1st row as column heading - yes / no. option ?


Thansk & Regards,

--Swapan

[mol]

Try to change some code in my app:

Code: Select all

#define CRLF Chr( 13 ) + Chr( 10 )

#include "minigui.ch"

PROCEDURE MAIN()

	DEFINE WINDOW main_form ;
		AT 114,218 ;
		WIDTH 334 ;
		HEIGHT 276 ;
		TITLE 'KONWERSJA DANYCH KERN-LIEBERS' ;
		MAIN

		DEFINE MAIN MENU

			DEFINE POPUP "Konwersja"
				MENUITEM 'Konwersja Eingang Paletten - palety przychodzące' ACTION PaletyPrzych()
				MENUITEM 'Konwersja Zuteilung Paletten - zlecenia' ACTION Zlecenia()
				MENUITEM 'Uzupełnij palety o numery zleceń' ACTION Uzupelnij()
			END POPUP

		END MENU

	END WINDOW 

	Main_form.center
	Main_form.activate

Return NIL

RETURN

//--------------------------------------------------------------------

STATIC PROCEDURE PaletyPrzych()
LOCAL oExcel, oAktArkusz

   oExcel := CreateObject( "Excel.Application")

   //oExcel:WorkBooks:Add()
   //oAktywnyArkusz := oExcel:ActiveSheet()
   oExcel:Workbooks:Open( GetCurrentFolder()+"\material.xls" ) 
   oExcel:WorkSheets("Eingang Paletten"):Select()
   oAktArkusz := oExcel:ActiveSheet
   
   msgbox(oAktArkusz:name)

   use palety new exclusive
   zap
nrpal:="AQQ" 
   nrWiersza := 6
   do while nrWiersza < 5242 .and. !empty(nrpal)
		select("palety")
		append blank
		replace;
			Data_Dost	with if(valtype(xxx := oAktArkusz:Cells( nrWiersza, 1 ):Value)=="D",xxx,ctod("")) ,;
			Data_Magaz	with if(valtype(xxx := oAktArkusz:Cells( nrWiersza, 2 ):Value)=="D",xxx,ctod("")),;
			PelnyNrPal	with strtran(oAktArkusz:Cells( nrWiersza, 3 ):Value," ","") ,;
			Dostawca	with oAktArkusz:Cells( nrWiersza, 4 ):Value ,;
			PolProdukt	with ZamienNaTekst(oAktArkusz:Cells( nrWiersza, 5 ):Value ),;
			NrZlecDost	with ZamienNaTekst(oAktArkusz:Cells( nrWiersza, 6 ):Value) ,;
			Ilosc_Dost	with if(valtype(XXX := oAktArkusz:Cells( nrWiersza, 7 ):Value) =="N", XXX,0) ,;
			NrDowoDost	with ZamienNaTekst(oAktArkusz:Cells( nrWiersza, 8 ):Value) ,;
			Data_Wyjsc	with if(valtype(xxx := oAktArkusz:Cells( nrWiersza, 10 ):Value)=="D",xxx,ctod("")) ,;
			DodOpis		with ZamienNaTekst(oAktArkusz:Cells( nrWiersza, 11 ):Value)

			pelnyNr := palety->PelnyNrPal
			replace;
				rk_palety	with substr(PelnyNr,3,2),;
				nr_palety	with substr(PelnyNr,5,4),;
				nrDod_Pal	with substr(PelnyNr,10,1)
				
			//NrZlecenia	with oAktArkusz:Cells( nrWiersza, 9 ):Value ,;
		nrWiersza++
		nrpal := strtran(oAktArkusz:Cells( nrWiersza, 3 ):Value," ","")
	enddo
	oExcel:Visible := .t.
	MsgBox("Zakończone")
	use
	oExcel := NIL
	
RETURN
*---------------------------
function Zlecenia
LOCAL oExcel, oAktArkusz

   oExcel := CreateObject( "Excel.Application")

   //oExcel:WorkBooks:Add()
   //oAktywnyArkusz := oExcel:ActiveSheet()
   oExcel:Workbooks:Open( GetCurrentFolder()+"\material.xls" ) 
   oExcel:WorkSheets("Zuteilung Paletten"):Select()
   oAktArkusz := oExcel:ActiveSheet
   
   msgbox(oAktArkusz:name)

   use zlec new exclusive
   zap
nrpal := "AQQ"   
   nrWiersza := 5
   do while nrWiersza < 5054 .and. !empty(nrpal)
		select("zlec")
		append blank
		replace;
			RkZlecenia	with substr(oAktArkusz:Cells( nrWiersza, 1 ):Value, 2,2 ),;
			NrZlecenia	with strtran(str(oAktArkusz:Cells( nrWiersza, 2 ):Value,4)," ","0") ,;
			TypZleceni	with substr(oAktArkusz:Cells( nrWiersza, 1 ):Value, 1,1 ),;
			PelnyNrPal	with strtran(oAktArkusz:Cells( nrWiersza, 3 ):Value," ","") ,;
			Ilosc		with if(valtype(x0 := oAktArkusz:Cells( nrWiersza, 4 ):Value)=="N",x0,0)  ,;
			IloscPalet	with if(valtype(x0 := oAktArkusz:Cells( nrWiersza, 4 ):Value)=="N",x0,0)  ,;
			PolProdukt	with ZamienNaTekst(oAktArkusz:Cells( nrWiersza, 5 ):Value ),;
			Ilosc_Pozo	with if(valtype(x1 := oAktArkusz:Cells( nrWiersza, 6 ):Value)=="N",x1,0) ,;
			NrCzesci	with oAktArkusz:Cells( nrWiersza, 7 ):Value ,;
			Data_Zamkn	with if(valtype(xxx := oAktArkusz:Cells( nrWiersza, 8 ):Value)=="D",xxx,ctod("")) ,;
			Zamkniete	with !empty(xxx) ,;
			Ilosc_Konc	with if(valtype(x11:= oAktArkusz:Cells( nrWiersza, 9 ):Value)=="N",x11,0)  ,;
			Odpad1		with if(valtype(x2 := oAktArkusz:Cells( nrWiersza, 10 ):Value)=="N",x2,0) ,;
			Odpad2		with if(valtype(x3 := oAktArkusz:Cells( nrWiersza, 11 ):Value)=="N",x3,0)  ,;
			Odpad3		with if(valtype(x4 := oAktArkusz:Cells( nrWiersza, 12 ):Value)=="N",x4,0)  ,;
			Odpad4		with if(valtype(x5 := oAktArkusz:Cells( nrWiersza, 13 ):Value)=="N",x5,0)  ,;
			Odpad5		with if(valtype(x6 := oAktArkusz:Cells( nrWiersza, 14 ):Value)=="N",x6,0)  ,;
			Odpad6		with if(valtype(x7 := oAktArkusz:Cells( nrWiersza, 15 ):Value)=="N",x7,0)

//			NrZlecenia	with strtran(str(oAktArkusz:Cells( nrWiersza, 1 ):Value, 4 ), " ","0"),;

		nrWiersza++
		nrpal := substr(oAktArkusz:Cells( nrWiersza, 1 ):Value, 2,2 )
	enddo
	oExcel:Visible := .t.
	MsgBox("Zakończone")
	use
	oExcel := NIL

return
*-----------------
function ZamienNaTekst
	param	xWartosc
	local ret
	
	if type("xWartosc") == "D"
		ret := dtoc(xWartosc)
	elseif type("xWartosc") == "N"
		ret := str(xWartosc)
	elseif type("xWartosc") == "L"
		ret := if(xWartosc,"True","false")
	elseif type("xWartosc") = "C"
		ret := xWartosc
	else
		ret := ""
	endif
 return ret
 *-------------------
 
 function uzupelnij
 
 use palety new exclusive
 index on PelnyNrPal to palety1
 
 use zlec new exclusive
 
 go top
 do while !eof()
	if palety->(DBSeek(zlec->PelnyNrPal))
		replace palety->NrZlecenia	with zlec->(TypZleceni+RkZlecenia+NrZlecenia)
	endif
	skip
enddo
close databases
MsgBox("Done...")
return

[Alex Gustow]

Thanks Marek! Right now (1 hour ago) my chief ask me to create app exactly for such job (to import many .XLS's - from user-pointed folder - to many DBF's). I look to HMGforum - and see your code! Excellent!! You save my time

[mol]

I'm glad that my work will help you!

[sudip]

Hello Marek,

Great work Thanks a lot

With best regards.

Sudip

[swapan]

I'm glad that my work will help you!

Thanks Marek for the prompt feedback with such excellent routine. Hummm..... the code is not in english....

Its good to see that my request has helped Alex also. Once again thanks "mol" for the code, an english version of that would have been just fabulous. Usually there are certain issues importing from MS-Excel 2007......., is it handling them also?

[Alex Gustow]

[Hummm..... the code is not in english....

Why "not in enlish"? Only variables, fields and functions names on Poland (and some labels). You can change them as you like. For example: "oAktArkusz" - "oSheet" an so on... This is simple.

But when I try to research prog with Spain or Italian comments (and I don't know Spain or Italian)... or you try to read comments on Russian into my prog ... that's really hard work

[mol]

I'll try to rewrite it in English, If I find some free time...

But - this program was tested and runs OK.

About Excel 2007 - of course it works! I'll try today if it orks with Excel 2010 beta - I'll write about test tomorrow.

Try to find my posts about working with few versions of Excel - iwas written some informations about it about year ago..

Marek

[Vanguarda]

Hi friends,

Marek, thanks for sharing this wonderfull function with us. It is very useful.

My best regards,

[mol]

I've tried to export to Excel 2010 and it works OK.