Dbf to Xls

[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

[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.

[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

[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

[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 )

[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

[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 )

[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

[Enrico Maria Giordano]

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

[Rick Lipkin]

Enrico ...

Thank you .. think this will be perfect ..

Rick Lipkin

[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 )

[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

[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

[Rick Lipkin]

Follow up ..

Get right justified as opposed to left justified ..

Thanks
Rick Lipkin

[Enrico Maria Giordano]

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