Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Fast
Message
 
 
To
03/11/2009 07:38:53
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Title:
Re: Fast
Miscellaneous
Thread ID:
01432885
Message ID:
01432900
Views:
74
Do you want to combine your Excel files into one Excel file afterwards?

See this function
function CombineExcelFiles (taXLSFiles, tcDestination, tlDeleteOriginal)
external array taXLSFiles
local loExcel as Excel.application, ;
	loWorkBook as Excel.Worksbook, ;
	loWorkSheet , ;
	lnCounter, lcWorkSheetCaption, lcError, ;
	lcValidChars

lcError = ""

try
	lcValidChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789 "
	loExcel = newobject("Excel.Application")
	with loExcel
		.ScreenUpdating = .f.
		.DisplayAlerts = .f.
		.WorkBooks.add()
		lnCounter = 0

** Delete all existing worksheets except 1
		for each loWorkSheet in .WorkBooks(1).WorkSheets
			lnCounter = m.lnCounter + 1
			if m.lnCounter > 1
				loWorkSheet.delete
			endif
		endfor

		for lnCounter = 1 to alen(taXLSFiles,1)
			if file(taXLSFiles[m.lnCounter])
				lcWorkSheetCaption = juststem(taXLSFiles[m.lnCounter])
				loWorkBook = .WorkBooks.open(taXLSFiles[m.lnCounter])
				loWorkBook.WorkSheets(1).copy(null, ;
					.WorkBooks(1).WorkSheets(.WorkBooks(1).WorkSheets.count))
				.WorkBooks(1).ActiveSheet.name = ;
					right(alltrim(chrtran(m.lcWorkSheetCaption, ;
					chrtran(m.lcWorkSheetCaption,m.lcValidChars,"")," ")), 31) &&loWorkBook.Name
				loWorkBook.close(.f.) && Don't save changes
				if m.tlDeleteOriginal
					erase (taXLSFiles[m.lnCounter])
				endif
			endif
		endfor
** Remove the first original sheet from (Sheet1)
		.WorkBooks(1).WorkSheets(1).delete

		.WorkBooks(1).saveas(m.tcDestination)
		.ScreenUpdating = .t.
		.DisplayAlerts = .t.
	endwith

catch to loError
	lcError = Log_Error(m.loError)
finally
	if vartype(m.loExcel) = 'O'
		with loExcel
			.ScreenUpdating = .t.
			.DisplayAlerts = .t.
			.quit()
		endwith
	endif
endtry

return m.lcError
endfunc
>hi all.
>
>i try as below it works is there another way to do it fast
>
>SELECT * FROM koko WHERE numbers=1  INTO CURSOR Sheet1
>COPY TO  sheet1 TYPE XL5 && it works
>&& is there away to copy to book1.sheet1  TYPE XL5
>
>SELECT * FROM koko WHERE numbers=2  INTO CURSOR Sheet2
>COPY TO  sheet2 TYPE XL5 &&
>&& copy to book1.sheet2 
>.
>.
>.
>
>SELECT * FROM koko WHERE numbers=18  INTO CURSOR Sheet18
>COPY TO  sheet18 TYPE XL5 &&
>&& copy to book1.sheet18 
>
>
>thanks
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