Page 1 of 3
Dbf to Xls
Posted: Thu Mar 22, 2007 12:36 am
by Rick Lipkin
To All
I know I have seen bits and pieces of Excel code .. I need a routine to extract certain fields and data from a dbf table and copy\create an excel .xls .. 2000\2003.
Any help or code snippits would be appreciated .. xHarbour\Fwh.
Thanks
Rick Lipkin
SC Dept of Health, USA
Posted: Thu Mar 22, 2007 12:49 am
by R.F.
What flavour of XL do you prefer ?
Class FileXLS can create XLS files directly without the need of having Excel installed. Files created with file XLS are Office97 and forward compatible, but they are not multibook.
You can also try Class XLScript, this class works using OLE and handle multibook spreadsheets, you will need to have Excel installed on the computer you are running your program.
FileXLS is fast but it doesn't have all the Excel stuff available, XLSCript is not as fast, but you have all the Excel features at your fingers.
Re: Dbf to Xls
Posted: Thu Mar 22, 2007 8:07 am
by Enrico Maria Giordano
Code: Select all
FUNCTION MAIN()
LOCAL oExcel, oSheet
LOCAL nRow
oExcel = CREATEOBJECT( "Excel.Application" )
oExcel:WorkBooks:Add()
oSheet = oExcel:ActiveSheet
USE TEST
nRow = 1
WHILE !EOF()
oSheet:Cells( nRow, 1 ):Value = FIELD -> last
oSheet:Cells( nRow, 2 ):Value = FIELD -> first
nRow++
SKIP
ENDDO
oExcel:Visible = .T.
RETURN NIL
EMG
Posted: Thu Mar 22, 2007 7:09 pm
by Rick Lipkin
I was looking for Excel 2000 or greater compatability .. Enrico has some good code there .. I am going to try that .. looks exacally like what I need ..
Thanks to you both ..
Rick Lipkin
Posted: Thu Mar 22, 2007 8:19 pm
by Gale FORd
I have found that if you have a number of cells to update, then copy and paste works 1000's of times faster than individual cell updates using ole.
Here is an example with xHarbour and FWH
Code: Select all
function test
local nCounter, nStart, oClipBoard
local oExcel, oWorkBook, oSheet
// create excel objects
oExcel = CREATEOBJECT( "Excel.Application" )
oExcel:WorkBooks:Add()
oWorkBook = oExcel:Get( "ActiveWorkBook" )
oSheet = oExcel:Get( "ActiveSheet" )
nCounter := 1
nStart := nCounter
cMemo := ''
do while .not. eof()
// build record
cMemo += Field1
cMemo += chr(9)+Field2
cMemo += chr(9)+Field3
cMemo += CRLF
nCounter++
skip
// update sheet every 1000 records or eof()
if mod( nCounter, 1000 ) = 0 .or. eof()
oClipBoard := tclipboard():New()
if oClipBoard:Open()
oClipBoard:SetText( cMemo )
oClipBoard:Close()
endif
pClipBoard:close()
oExcel:oSheet:Cells( nStart, 1 ):Select()
oExcel:oSheet:paste()
nStart := nCounter
cMemo := ''
endif
enddo
return( nil )
Posted: Fri Mar 23, 2007 12:16 am
by Rick Lipkin
Enrico .. here is your modified code .. 2 questions
1) oExcel:Visible = .T. starts up Excel when the program is finished and you can save the spreadsheet .. however .. I do not want to start Excel .. just save the output to a <file.xls>
2) How do I include the header descriptions as the first row ?
also .. I notice if the dates are 'invalid' or empty() .. this program has a run-time failure .. I have fixed the empty() date .. but what if there is an invalid date .. how do I test for a bad date like "06/31/2006"
Thanks
Rick Lipkin
// dbf to xls conversion
LOCAL oExcel, oSheet
LOCAL nRow
clear
REQUEST DBFCDX
rddsetdefault( "DBFCDX" )
oExcel := CREATEOBJECT( "Excel.Application" )
oExcel:WorkBooks:Add()
oSheet := oExcel:ActiveSheet
select 1
USE cert via "DBFCDX" shared
go top
nRow := 1
Do WHILE !EOF()
@ 10,10 say str(Nrow)+" "+cert->name
if deleted()
select cert
skip
loop
endif
oSheet:Cells( nRow, 1 ):Value = cert->reg_no
oSheet:Cells( nRow, 2 ):Value = cert->name
oSheet:Cells( nRow, 3 ):Value = cert->addr1
oSheet:Cells( nRow, 4 ):Value = cert->addr2
oSheet:Cells( nRow, 5 ):Value = cert->addr3
oSheet:Cells( nRow, 6 ):Value = cert->city
oSheet:Cells( nRow, 7 ):Value = cert->state
oSheet:Cells( nRow, 8 ):Value = cert->zip
oSheet:Cells( nRow, 9 ):Value = cert->zip4
oSheet:Cells( nRow, 10 ):Value = cert->schd
oSheet:Cells( nRow, 11 ):Value = if(EMPTY(cert->expir_date), "00/00/00", cert->expir_date)
oSheet:Cells( nRow, 12 ):Value = if(EMPTY(cert->init_date), "00/00/00", cert->init_date)
nRow++
@ 10,10 say str(Nrow)+" "+cert->name
select cert
SKIP
ENDDO
* oExcel:Visible = .T.
close databases
quit
Posted: Fri Mar 23, 2007 12:23 am
by Rick Lipkin
Gale .. here is your modified code .. which generates a runtime error ..
Same 2 questions I asked Enrico .. how do I put column headers in the file and how do I create the .xls file without opening Excel ??
Thanks
Rick Lipkin
Application
===========
Path and name: c:\FOX\DC\Dbf2Xls1.Exe (32 bits)
Size: 1,383,424 bytes
Time from start: 0 hours 0 mins 1 secs
Error occurred at: 03/22/07, 20:08:44
Error description: Error BASE/1004 Class: 'NIL' has no exported method: HWND
Args:
Stack Calls
===========
Called from: => HWND(0)
Called from: CLIPBRD.PRG => (b)TCLIPBOARD:TCLIPBOARD(0)
Called from: CLIPBRD.PRG => TCLIPBOARD:OPEN(0)
Called from: EXCEL1.PRG => MAIN(54)
// dbf2xls conversion
#include "fivewin.ch"
function Main()
local nCounter, nStart, oClipBoard
local oExcel, oWorkBook, oSheet
// create excel objects
oExcel = CREATEOBJECT( "Excel.Application" )
oExcel:WorkBooks:Add()
oWorkBook = oExcel:Get( "ActiveWorkBook" )
oSheet = oExcel:Get( "ActiveSheet" )
nCounter := 1
nStart := nCounter
cMemo := ''
REQUEST DBFCDX
rddsetdefault( "DBFCDX" )
select 1
use cert via "DBFCDX" shared
go top
do while .not. eof()
// build record
cMemo += cert->reg_no
cMemo += chr(9)+cert->name
cMemo += chr(9)+cert->addr1
cMemo += chr(9)+cert->addr2
cMemo += chr(9)+cert->addr3
cMemo += chr(9)+cert->city
cMemo += chr(9)+cert->state
cMemo += chr(9)+cert->zip
cMemo += chr(9)+cert->zip4
cMemo += chr(9)+cert->schd
cMemo += chr(9)+dtoc(cert->expir_date)
cMemo += chr(9)+dtoc(cert->init_date)
cMemo += CRLF
nCounter++
skip
// update sheet every 1000 records or eof()
if mod( nCounter, 1000 ) = 0 .or. eof()
oClipBoard := tclipboard():New()
if oClipBoard:Open() // error here
oClipBoard:SetText( cMemo )
oClipBoard:Close()
endif
pClipBoard:close()
oExcel:oSheet:Cells( nStart, 1 ):Select()
oExcel:oSheet:paste()
nStart := nCounter
cMemo := ''
endif
enddo
close databases
quit
return( nil )
Posted: Fri Mar 23, 2007 6:09 am
by James Bott
Rick,
>how do I test for a bad date like "06/31/2006"
I haven't tried this but you could try:
function isDate( cDate )
return if(emtpy(ctod( cDate )),.f.,.t.)
James
Posted: Fri Mar 23, 2007 8:05 am
by Enrico Maria Giordano
Rick Lipkin wrote:Enrico .. here is your modified code .. 2 questions
This is a modified version of my sample:
Code: Select all
FUNCTION MAIN()
LOCAL oExcel, oSheet
LOCAL nRow
oExcel = CREATEOBJECT( "Excel.Application" )
oExcel:WorkBooks:Add()
oSheet = oExcel:ActiveSheet
USE TEST
oSheet:Cells( 1, 1 ):Value = "LAST"
oSheet:Cells( 1, 2 ):Value = "FIRST"
oSheet:Cells( 1, 3 ):Value = "HIREDATE"
nRow = 2
WHILE !EOF()
oSheet:Cells( nRow, 1 ):Value = FIELD -> last
oSheet:Cells( nRow, 2 ):Value = FIELD -> first
oSheet:Cells( nRow, 3 ):Value = FIELD -> hiredate
nRow++
SKIP
ENDDO
oSheet:Cells( nRow, 1 ):Value = "Test for"
oSheet:Cells( nRow, 2 ):Value = "empty date"
oSheet:Cells( nRow, 3 ):Value = CTOD( "" )
oSheet:Columns( "A:C" ):AutoFit()
// oExcel:Visible = .T.
FERASE( "C:\XHARBOUR\SAVED.XLS" )
oSheet:SaveAs( "C:\XHARBOUR\SAVED.XLS" )
oExcel:Quit()
RETURN NIL
EMG
Posted: Fri Mar 23, 2007 2:24 pm
by Rick Lipkin
Enrico ...
Thank you .. think this will be perfect ..
Rick Lipkin
Posted: Fri Mar 23, 2007 3:35 pm
by Gale FORd
The example I posted required Fivewin to have an open window.
Here is another example that can compile and run with just xHarbour.com
The results I get are were
Ole = 18.67 seconds
Clipboard = .20 seconds
Quite a difference.
Code: Select all
// #include "fivewin.ch"
FUNCTION MAIN()
LOCAL oExcel, oSheet
LOCAL nRow
LOCAL nCounter, nStart, nSeconds, nSecOle, nSecClip
oExcel = CREATEOBJECT( "Excel.Application" )
oExcel:WorkBooks:Add()
oSheet = oExcel:ActiveSheet
nRow := 1
oSheet:Cells( nRow, 1 ):Value = "Counter"
oSheet:Cells( nRow, 2 ):Value = "Date"
oSheet:Cells( nRow, 3 ):Value = "Row"
nCounter := 1
nStart := nCounter
nSeconds := seconds()
DO WHILE nCounter < 2000
oSheet:Cells( nCounter+nRow, 1 ):Value = nCounter
oSheet:Cells( nCounter+nRow, 2 ):Value = date()-nCounter
oSheet:Cells( nCounter+nRow, 3 ):Value = nCounter-1
nCounter++
ENDDO
nSecOle := seconds()-nSeconds
nRow += nCounter+2
oSheet:Cells( nRow, 1 ):Value = "Counter"
oSheet:Cells( nRow, 2 ):Value = "Date"
oSheet:Cells( nRow, 3 ):Value = "Row"
nSeconds := seconds()
nCounter := 1
nStart := nCounter
cMemo := ''
DO WHILE nCounter < 2000
// build record
cMemo += ltrim( str( nCounter ) )
cMemo += chr(9)+dtoc( date()-nCounter )
cMemo += chr(9)+ltrim( str( nCounter+nRow-1 ) )
cMemo += chr(10)
nCounter++
// update sheet every 1000 records or eof()
IF mod( nCounter, 1000 ) = 0 // .or. eof()
// This is for Fivewin Code
/*
oClipBoard := tClipBoard():New()
IF oClipBoard:Open()
oClipBoard:SetText( cMemo )
oClipBoard:Close()
ENDIF
*/
// This is for xHarbour Console
GTSetClipboard( cMemo )
oSheet:Cells( nRow+nStart, 1 ):Select()
oSheet:paste()
nStart := nCounter
cMemo := ''
ENDIF
ENDDO
// clear clipboard buffer (Fivewin Code)
/*
oClp := TClipBoard():New()
IF oClp:Open()
oClp:SetText( '' )
oClp:Close()
ENDIF
msginfo( 'Ole = '+ltrim(str(nSecOle))+CRLF+;
'Clip = '+ltrim(str(nSecClip)) )
*/
// This is for xHarbour Console
nSecClip := seconds()-nSeconds
? 'Ole = '+ltrim(str(nSecOle))
? 'Clip = '+ltrim(str(nSecClip))
wait
nSecClip := seconds()-nSeconds
oSheet:Columns( "A:C" ):AutoFit()
oExcel:Visible = .T.
// FERASE( "C:\XHARBOUR\SAVED.XLS" )
//
// oSheet:SaveAs( "C:\XHARBOUR\SAVED.XLS" )
// oExcel:Quit()
RETURN( nil )
Posted: Fri Mar 23, 2007 9:17 pm
by Jeff Barnes
Hi Rick,
You might also find this useful. It's a list (short but a good start) of commands that you can use...
http://www.fivewin.info/html/tips___tri ... .php?id=46
Jeff
Posted: Mon Mar 26, 2007 1:44 pm
by Rick Lipkin
To All
Now that I have the code running .. I am getting justification problems with charactor fields that contain alpha and numeric information ..
Example .. in the reg_no column I have two rows :
reg_no
2306753
20A118
For some reason .. the alpha numeric get left justified .. which causes our SQL loader to fail .. any way to make sure all the contents of the column get left justified ??
Thanks
Rick Lipkin
SC Dept of Health, USA
Code:
// dbf to xls conversion
LOCAL oExcel, oSheet
LOCAL nRow, cFILE,aDIR,mSTART,cDEFA
clear
REQUEST DBFCDX
rddsetdefault( "DBFCDX" )
setmode( 25,80 )
//-- get timestamp on .exe //
cFILE := HB_ARGV(0)
aDIR := DIRECTORY( cFILE )
// where .exe started from is default directory //
mSTART := RAT( "\", cFILE )
cDEFA := SUBSTR(cFILE,1,mSTART-1)
aDIR := NIL
SET DEFA to ( cDEFA )
oExcel := CREATEOBJECT( "Excel.Application" )
oExcel:WorkBooks:Add()
oSheet := oExcel:ActiveSheet
select 1
USE cert via "DBFCDX" shared
go top
oSheet:Cells( 1, 1 ):value := "REG_NO"
oSheet:Cells( 1, 2 ):value := "NAME"
oSheet:Cells( 1, 3 ):value := "ADDR1"
oSheet:Cells( 1, 4 ):value := "ADDR2"
oSheet:Cells( 1, 5 ):value := "ADDR3"
oSheet:Cells( 1, 6 ):value := "CITY"
oSheet:Cells( 1, 7 ):value := "STATE"
oSheet:Cells( 1, 8 ):value := "ZIP"
oSheet:Cells( 1, 9 ):value := "ZIP4"
oSheet:Cells( 1, 10):value := "SCHD"
oSheet:Cells( 1, 11):value := "INIT_DATE"
oSheet:Cells( 1, 12):value := "EXPIR_DATE"
nRow := 2
Do WHILE !EOF()
@ 10,10 say str(Nrow)+" "+cert->name
if deleted()
select cert
skip
loop
endif
oSheet:Cells( nRow, 1 ):Value := cert->reg_no
oSheet:Cells( nRow, 2 ):Value := cert->name
oSheet:Cells( nRow, 3 ):Value := cert->addr1
oSheet:Cells( nRow, 4 ):Value := cert->addr2
oSheet:Cells( nRow, 5 ):Value := cert->addr3
oSheet:Cells( nRow, 6 ):Value := cert->city
oSheet:Cells( nRow, 7 ):Value := cert->state
oSheet:Cells( nRow, 8 ):Value := cert->zip
oSheet:Cells( nRow, 9 ):Value := cert->zip4
oSheet:Cells( nRow, 10 ):Value := cert->schd
oSheet:Cells( nRow, 11 ):Value := if(EMPTY(cert->expir_date), "00/00/00", cert->expir_date)
oSheet:Cells( nRow, 12 ):Value := if(EMPTY(cert->init_date), "00/00/00", cert->init_date)
nRow++
@ 10,10 say str(Nrow)+" "+cert->name
select cert
SKIP
ENDDO
oSheet:Columns( "A:L" ):AutoFit()
* oExcel:Visible = .T.
ferase( cDEFA+"\CERT.XLS" )
oSheet:SaveAs( cDEFA+"\CERT.XLS" )
oExcel:Quit()
close databases
quit
Posted: Mon Mar 26, 2007 1:45 pm
by Rick Lipkin
Follow up ..
Get right justified as opposed to left justified ..
Thanks
Rick Lipkin
Posted: Mon Mar 26, 2007 3:28 pm
by Enrico Maria Giordano
Rick Lipkin wrote:any way to make sure all the contents of the column get left justified ??
Code: Select all
oSheet:Cells( nRow, 1 ):Value := "'" + cert->zip
EMG