DBF To Excel

You can share your experience with HMG. Share with some screenshots/project details so that others will also be benefited.

Moderator: Rathinagiri

User avatar
sudip
Posts: 1446
Joined: Sat Mar 07, 2009 11:52 am
Location: Kolkata, WB, India
Has thanked: 5 times
Been thanked: 1 time

Re: DBF To Excel

Post by sudip » Fri Mar 27, 2009 2:57 pm

Hi Danny, Hi Luis,

Thank you! I am very happy that you like the application! :) Danny, do you know Hindi ("sukria"???), but I don't speak hindi. My mother tongue is Bengali, which says "dhanyobad" := "thank you". :)
I didn't expect so many message regarding this application!!! :)

Hi Esgici,
Also I am happy by seeing realized a big step in one of my wish in older posts :

Quote:
I hope that this will be a good example and starting point for developing a generic and versatile .dbf to .xls conversion routine/module.
I am trying to learn HMG. And I always want to show you all what I am learning, so that if you find anything wrong in my learning, I can easily rectify it. I believe that true success is not the "destination", it is the experience through which we going to our destination. :)

With best regards to you all.

Sudip
With best regards,
Sudip

User avatar
swapan
Posts: 242
Joined: Mon Mar 16, 2009 4:23 am
Location: Kolkata, India
Contact:

Post by swapan » Mon Mar 30, 2009 5:32 am

sudip wrote:Dear Swapan,

Can you please tell me exactly what's the error message (like MOL sent), so that I shall rectify the code.

Thank you for testing!!! :)

Regards.

Sudip
FYI......
The issue was same, mentioned by MOL (Marek), and resolution is same what suggested by MOL.

Please note: One Record is coming less in excel. Have a dbf of 1-2 records and u can see the last record doen't gets into excel sheet.
Thanks & Regards,
Swapan Das

http://www.swapandas.com/

User avatar
sudip
Posts: 1446
Joined: Sat Mar 07, 2009 11:52 am
Location: Kolkata, WB, India
Has thanked: 5 times
Been thanked: 1 time

Post by sudip » Mon Mar 30, 2009 10:55 am

Hi Swapan,

Thank you very much. Yes, it had a serious error in the loop. I corrected it. Please check it.

Code: Select all

#include "minigui.ch"
#include "excel.ch"

Function Main()
   Local cFile := GetFile({{'DBF File','*.dbf'}}, 'DBF File')
   Local a_fields , cAlias

   if empty(cFile)
      Return Nil
   endif
   If ! File( cFile )
      MSGSTOP("File I/O error, cannot proceed")
      Return Nil
   ENDIF

   cAlias :=ALLTRIM(substr(cFile,Rat('\',cFile)+1))
   cAlias :=substr(cAlias,1,len(cAlias)-4)
   
      
   use &cFile alias &cAlias
   a_fields := {}
   
   for n:=1 to fcount()
      aadd( a_fields , fieldname( n ) )
   next

   Define Window winMain ;
      at 0, 0 ;
      width 470 ;
      height 350 ;
      title cFile ;
      main ;
      nomaximize
         
   	@ 10, 10 button cmdShowexcel caption "Show in Excel" ;
   		action ShowExl(cAlias, a_fields, a_fields, cFile)
   end window
   
   winMain.center
   winMain.activate
 	return nil
   
   

function ShowExl(cAlias, aFldnm, aPrompt, mHeading)
private oExcel, nRow, nStartRow, mPrevRow, cMemo, mesg, i, mTemp

   oExcel = CREATEOBJECT( "Excel.Application" )
   oExcel:WorkBooks:Add()
   oSheet = oExcel:ActiveSheet
   //oExcel:ActiveWindow:DisplayGridlines = .f.
   nRow := 1

   nRow++
   with object oSheet
      for i = 1 to len(aPrompt)
         :Cells(nRow, i):Value = aPrompt[i]
      next
   end
   nRow++

   select &cAlias
   nStartRow = nRow
   cMemo = ""

   do while inkey() != 27 .and. !eof()



      FOR i = 1 TO len(aFldnm)
        mTemp = eval(fieldblock(aFldnm[i]))
         do case
            case valtype(mTemp) $ "CM"
               cMemo += alltrim(mTemp)
            case valtype(mTemp) = "D"
               cMemo += ExcelDt(mTemp)
            case valtype(mTemp) = "N"
               cMemo += ltrim(str(mTemp, 12, 2))
            case valtype(mTemp) = "L"
               cMemo += iif(mTemp, "Yes", "No")
         endcase
         cMemo += chr(9)
      NEXT
      
      cMemo += chr(10)

      mPrevrow = nRow
      nRow++
      
      skip
      
      if (inkey() = 27 .or. eof()) .or. mod(nRow, 1000) = 0
         CopyToClipboard( cMemo )
         oSheet:Cells( nStartRow, 1 ):Select()
         oSheet:paste()
         nStartRow := nRow
         cMemo := ''
      ENDIF         

      select &cAlias
   enddo

   //oSheet:Columns( "A:"+chr(asc("A")+len(aFldnm))):AutoFit()
   if mHeading <> NIL
      oSheet:Cells( 1, 1 ):Value = mHeading
   endif
   oSheet:Range("A1"):select()

   oExcel:Visible = .T.
   return nil

   
   
function CopyToClipboard
	param cTekst
	#define HB_GTI_CLIPBOARDDATA 15
	hb_gtInfo( HB_GTI_CLIPBOARDDATA, cTekst )
	return



function ExcelDt(mDt)
   return (ltrim(str(day(mDt)))+"-"+left(cmonth(mDt), 3)+"-"+str(year(mDt), 4))
   
   
   
function ExcelBorder(oSheet, col1, row1, col2, row2)
   local mRange
   mRange = col1+ltrim(str(row1))+":"+col2+ltrim(str(row2))
   oSheet:Range(mRange):Borders(xlEdgeTop):LineStyle = xlContinuous
   oSheet:Range(mRange):Borders(xlEdgeLeft):LineStyle = xlContinuous
   oSheet:Range(mRange):Borders(xlEdgeBottom):LineStyle = xlContinuous
   oSheet:Range(mRange):Borders(xlEdgeRight):LineStyle = xlContinuous
   return   
You can download the code from
ShowExcel.zip
(10.33 KiB) Downloaded 689 times


Please advise me how to improve the code as before :)

With best regards.

Sudip
With best regards,
Sudip

User avatar
mol
Posts: 3197
Joined: Thu Sep 11, 2008 5:31 am
Location: Myszków, Poland
Has thanked: 214 times
Been thanked: 120 times
Contact:

Post by mol » Mon Mar 30, 2009 1:03 pm


cMemo += chr(10)

mPrevrow = nRow
nRow++

skip

if (inkey() = 27 .or. eof()) .or. mod(nRow, 1000) = 0
CopyToClipboard( cMemo )
oSheet:Cells( nStartRow, 1 ):Select()
oSheet:paste()
nStartRow := nRow
cMemo := ''
ENDIF

select &cAlias
enddo
In my opinion, problem exist because ent of the loop do while - enddo should look like this:

cMemo += chr(10)

mPrevrow = nRow
nRow++

if (inkey() = 27 .or. eof()) .or. mod(nRow, 1000) = 0
CopyToClipboard( cMemo )
oSheet:Cells( nStartRow, 1 ):Select()
oSheet:paste()
nStartRow := nRow
cMemo := ''
ENDIF

select &cAlias

skip

enddo
(simply move SKIP to the end of loop)

User avatar
sudip
Posts: 1446
Joined: Sat Mar 07, 2009 11:52 am
Location: Kolkata, WB, India
Has thanked: 5 times
Been thanked: 1 time

Post by sudip » Mon Mar 30, 2009 4:45 pm

Hi Marek,

Is my latest code still buggy?

Regards.

Sudip
With best regards,
Sudip

User avatar
sudip
Posts: 1446
Joined: Sat Mar 07, 2009 11:52 am
Location: Kolkata, WB, India
Has thanked: 5 times
Been thanked: 1 time

Post by sudip » Mon Mar 30, 2009 5:25 pm

Hi,

HMG 2.7.0 has new System object. Using this handling Clipboard is very easy. :)

I also changed my code. My previous code:

Code: Select all

         CopyToClipboard( cMemo )
Modified code:

Code: Select all

         System.clipboard := cMemo
Thank you Roberto Lopez. :)

With best regards.

Sudip
With best regards,
Sudip

User avatar
mol
Posts: 3197
Joined: Thu Sep 11, 2008 5:31 am
Location: Myszków, Poland
Has thanked: 214 times
Been thanked: 120 times
Contact:

Post by mol » Tue Mar 31, 2009 6:55 am

Hi Sudip!
I'm working with export to Excel in few applications.
I was looking for more examples, and found working application which uses more excel functions (Sorry, I don't remember author...):
oSheet:Cells( 1, 1 ):Font:Size := 12
oSheet:Cells( 1, 1 ):Font:Bold := .t.
oSheet:Cells( 1, 1 ):Value := "Invoice-Overview"
oSheet:Cells( 1, 1 ):Set( "HorizontalAlignment", xlLeft )
oSheet:Range( "A1:E1" ):Merge()
I tried to use it in my HMG project, but always get error: This method is not available: FONT


Maybe libraries in mingw used with hmg are old, cut ????

Esgici, Rathinagiri, what do you think about it?

User avatar
mol
Posts: 3197
Joined: Thu Sep 11, 2008 5:31 am
Location: Myszków, Poland
Has thanked: 214 times
Been thanked: 120 times
Contact:

Post by mol » Tue Mar 31, 2009 7:26 am

So, simple function oExcel:SaveAs(...) doesn't work too.


I want to add that example which works ok, uses xharbour and bcc55.

User avatar
Rathinagiri
Posts: 5263
Joined: Tue Jul 29, 2008 6:30 pm
DBs Used: MariaDB, SQLite, SQLCipher and MySQL
Location: Sivakasi, India
Has thanked: 169 times
Been thanked: 172 times
Contact:

Post by Rathinagiri » Tue Mar 31, 2009 7:42 am

I think you are using

oSheet:Cells( 1, 1 ):NumberFormat := "##########0.00"

I am using like this, and it works fine. We have to see whether it can be used to set the font property too.

oSheet:Cells( 1, 1 ):Set ("NumberFormat","##########0.00")
East or West HMG is the Best.
South or North HMG is worth.
...the possibilities are endless.

User avatar
Rathinagiri
Posts: 5263
Joined: Tue Jul 29, 2008 6:30 pm
DBs Used: MariaDB, SQLite, SQLCipher and MySQL
Location: Sivakasi, India
Has thanked: 169 times
Been thanked: 172 times
Contact:

Post by Rathinagiri » Tue Mar 31, 2009 7:46 am

However, this is the testole.prg which clearly says "font:name" and "font:size" are possible. Let me check on that.

Code: Select all

/*
 * $Id: testole.prg 8142 2007-12-05 08:17:30Z vszakats $
 */

/*
 * Harbour Project source code:
 *    demonstration code for FOR EACH used for OLE objects
 *    this code needs HBWIN32 library
 *
 * Copyright 2007 Enrico Maria Giordano e.m.giordano at emagsoftware.it
 * www - http://www.harbour-project.org
 *
 */

/* Explicit usage of OLE DEFAULT Method when syntax implies it. */
#xtranslate :<!Method!>( <args,...> ) := => :<Method>( <args> ):Value :=

PROCEDURE Main()

   LOCAL nOption

   CLS
   SetColor("W+/R")
   @  6, 25 TO 19, 55 DOUBLE
   @  8, 28 SAY "Test Harbour OLE with..."

   While .t.
      @ 10, 32 PROMPT "MS Excel"
      @ 11, 32 PROMPT "MS Word"
      @ 12, 32 PROMPT "MS Outlook (1)"
      @ 13, 32 PROMPT "MS Outlook (2)"
      @ 14, 32 PROMPT "Internet Explorer"
      @ 15, 32 PROMPT "XP CDO"
      @ 16, 32 PROMPT "OpenOffice"
      @ 17, 32 PROMPT "Quit"

      MENU TO nOption

      IF nOption == 0
         nOption := 8
      ELSEIF nOption == 1
         Exm_MSExcel()
      ELSEIF nOption == 2
         Exm_MSWord()
      ELSEIF nOption == 3
         Exm_MSOutlook()
      ELSEIF nOption == 4
         Exm_MSOutlook2()
      ELSEIF nOption == 5
         Exm_IExplorer()
      ELSEIF nOption == 6
         Exm_CDO()
      ELSEIF nOption == 7
         Exm_OpenOffice()
      ELSEIF nOption == 8
         EXIT
      ENDIF
   End

   SetColor("W/N")
   CLS

   RETURN

// ; Requires Windows XP

STATIC PROCEDURE Exm_CDO()

   LOCAL oCDOMsg
   LOCAL oCDOConf

   BEGIN SEQUENCE WITH {|oErr| Break( oErr )}
      oCDOMsg := CreateObject( "CDO.Message" )
      BEGIN SEQUENCE WITH {|oErr| Break( oErr )}

         oCDOConf := CreateObject( "CDO.Configuration" )
         
         oCDOConf:Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") := 2 // ; cdoSendUsingPort
         oCDOConf:Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") := "localhost"
         oCDOConf:Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") := 25
         oCDOConf:Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") := 120
         oCDOConf:Fields:Update()
         
         oCDOMsg:Configuration := oCDOConf
         oCDOMsg:BodyPart:Charset := "iso-8859-2" // "iso-8859-1" "utf-8"
         oCDOMsg:To := "test@localhost"
         oCDOMsg:From := "sender@localhost"
         oCDOMsg:Subject := "Test message"
         oCDOMsg:TextBody := "Test message body"
         
         BEGIN SEQUENCE WITH {|oErr| Break( oErr )}
            oCDOMsg:Send()
         RECOVER
            Alert( "Error: CDO send error. [" + Ole2TxtError()+ "]" )
         END SEQUENCE

         oCDOConf := NIL

      END SEQUENCE

      oCDOMsg := NIL

   RECOVER
      Alert( "Error: CDO subsystem not available. [" + Ole2TxtError()+ "]" )
   END SEQUENCE

   RETURN

STATIC PROCEDURE Exm_IExplorer()

   LOCAL oIE

   BEGIN SEQUENCE WITH {|oErr| Break( oErr )}
      oIE := CreateObject( "InternetExplorer.Application" )
      BEGIN SEQUENCE WITH {|oErr| Break( oErr )}
         oIE:Visible := .T.
         oIE:Navigate( "http://www.harbour-project.org" )
      END SEQUENCE
   RECOVER
      Alert( "Error: IExplorer not available. [" + Ole2TxtError()+ "]" )
   END SEQUENCE

   RETURN

STATIC PROCEDURE Exm_MSExcel()

   LOCAL oExcel
   LOCAL oWorkBook
   LOCAL oWorkSheet
   LOCAL oAS

   BEGIN SEQUENCE WITH {|oErr| Break( oErr )}
      oExcel := CreateObject( "Excel.Application" )
      BEGIN SEQUENCE WITH {|oErr| Break( oErr )}
   
         oWorkBook := oExcel:WorkBooks:Add()
         
         FOR EACH oWorkSheet IN oWorkBook:WorkSheets
            ? oWorkSheet:Name
         NEXT
         
         oAS := oExcel:ActiveSheet()
         
         oAS:Cells:Font:Name := "Arial"
         oAS:Cells:Font:Size := 12
         
         // Explicit use of DEFAULT method by means of #xtranslate above!!!
         oAS:Cells( 3, 1 ) := "Explict DEFAULT Method Text:"
         
         // Array notation seem to have REVERSED indexs for the Cells Collections!!!
         // Implicitly using DEFAULT Method
         oAS:Cells[ 2, 3 ] := "Implicit DEFAULT Method using *reversed* array index notation"
         
         // Operator overloading will attempt explict resolutin using :OleValue
         oAS:Cells[ 2, 3 ] += "!"
         
         oAS:Cells( 4, 1 ):Value := "Numeric:"
         oAS:Cells( 4, 2 ):NumberFormat := "#.##0,00"
         
         oAS:Cells[ 2, 4 ] := 1234.50
         oAS:Cells[ 2, 4 ] *= 4
         ? oAS:Cells[ 2, 4 ], oAS:Cells[ 2, 4 ]:Value
         oAS:Cells[ 2, 4 ] /= 2
         ? oAS:Cells[ 2, 4 ], oAS:Cells[ 2, 4 ]:Value
         
         oAS:Cells[ 2, 4 ]++
         ? oAS:Cells[ 2, 4 ], oAS:Cells[ 2, 4 ]:Value
         oAS:Cells[ 2, 4 ]--
         ? oAS:Cells[ 2, 4 ], oAS:Cells[ 2, 4 ]:Value
         
         oAS:Cells( 5, 1 ):Value := "Logical:"
         oAS:Cells( 5, 2 ):Value := .T.
         oAS:Cells( 6, 1 ):Value := "Date:"
         oAS:Cells( 6, 2 ):Value := DATE()
         
         oAS:Columns( 1 ):Font:Bold := .T.
         oAS:Columns( 2 ):HorizontalAlignment := -4152  // xlRight
         
         oAS:Columns( 1 ):AutoFit()
         oAS:Columns( 2 ):AutoFit()
         
         oAS:Cells( 1, 1 ):Value := "OLE from Harbour"
         oAS:Cells( 1, 1 ):Font:Size := 16
         oAS:Range( "A1:B1" ):HorizontalAlignment := 7
         
         oAS:Cells( 1, 1 ):Select()
         
         oExcel:Visible := .T.
   
         oExcel:Quit()
   
      END SEQUENCE
   RECOVER
      Alert( "Error: MS Excel not available. [" + Ole2TxtError()+ "]" )
   END SEQUENCE

   RETURN

STATIC PROCEDURE Exm_MSWord()

   LOCAL oWord
   LOCAL oText

   BEGIN SEQUENCE WITH {|oErr| Break( oErr )}
      oWord := CreateObject( "Word.Application" )
      BEGIN SEQUENCE WITH {|oErr| Break( oErr )}

         oWord:Documents:Add()
         
         oText := oWord:Selection()
         
         oText:Text := "OLE from Harbour" + hb_OSNewLine()
         oText:Font:Name := "Arial"
         oText:Font:Size := 48
         oText:Font:Bold := .T.
         
         oWord:Visible := .T.
         oWord:WindowState := 1 // ; Maximize

      END SEQUENCE
   RECOVER
      Alert( "Error: MS Word not available. [" + Ole2TxtError()+ "]" )
   END SEQUENCE

   RETURN

STATIC PROCEDURE Exm_MSOutlook()

   LOCAL oOL
   LOCAL oList

   BEGIN SEQUENCE WITH {|oErr| Break( oErr )}
      oOL := CreateObject( "Outlook.Application" )
      BEGIN SEQUENCE WITH {|oErr| Break( oErr )}
         oList := oOL:CreateItem( 7 ) // ; olDistributionListItem
         oList:DLName := "Distribution List"
         oList:Display( .F. )
      END SEQUENCE
   RECOVER
      Alert( "Error: MS Outlook not available. [" + Ole2TxtError()+ "]" )
   END SEQUENCE

   RETURN

STATIC PROCEDURE Exm_MSOutlook2()

   LOCAL oOL
   LOCAL oLista
   LOCAL oMail
   LOCAL i

   oOL := TOleAuto():New( "Outlook.Application.9" )

   IF Ole2TxtError() != "S_OK"
      Alert("Outlook is not available", "Error")
   ELSE
      oMail := oOL:CreateItem( 0 )  // olMailItem

      FOR i := 1 TO 10
         oMail:Recipients:Add( "Contact" + LTRIM( STR( i, 2 ) ) + ;
               "<contact" + LTRIM( STR( i, 2 ) ) + "@server.com>" )
      NEXT

      oLista := oOL:CreateItem( 7 )  // olDistributionListItem
      oLista:DLName := "Test with distribution list"
      oLista:Display( .F. )
      oLista:AddMembers( oMail:Recipients )
      oLista:Save()
      oLista:Close( 0 )

      oMail:End()
      oLista:End()
      oOL:End()

   ENDIF

   RETURN

STATIC PROCEDURE Exm_OpenOffice()

   LOCAL oOO_ServiceManager
   LOCAL oOO_Desktop
   LOCAL oOO_PropVal01
   LOCAL oOO_Doc

   LOCAL cDir

   BEGIN SEQUENCE WITH {|oErr| Break( oErr )}

      oOO_ServiceManager := CreateObject( "com.sun.star.ServiceManager" )

      BEGIN SEQUENCE WITH {|oErr| Break( oErr )}

         hb_FNameSplit( hb_ArgV( 0 ), @cDir )

         oOO_Desktop := oOO_ServiceManager:createInstance( "com.sun.star.frame.Desktop" )
         oOO_PropVal01 := oOO_ServiceManager:Bridge_GetStruct( "com.sun.star.beans.PropertyValue" )
         oOO_Doc := oOO_Desktop:loadComponentFromURL( OO_ConvertToURL( hb_FNameMerge( cDir, "sample.odt" ) ), "_blank", 0, { oOO_PropVal01 } )

         // ...
         
         oOO_Doc:Close( .T. )
         oOO_Doc := NIL
         
         oOO_Desktop:Terminate()
         oOO_Desktop := NIL
         oOO_PropVal01 := NIL

      END SEQUENCE

      oOO_ServiceManager := NIL

   RECOVER
      Alert( "Error: OpenOffice not available. [" + Ole2TxtError()+ "]" )
   END SEQUENCE

   RETURN

STATIC FUNCTION OO_ConvertToURL( cString )

   // ; Handle UNC paths
   IF !( Left( cString, 2 ) == "\\" )
      cString := StrTran( cString, ":", "|" )
      cString := "///" + cString
   ENDIF

   cString := StrTran( cString, "\", "/" )
   cString := StrTran( cString, " ", "%20" )

   RETURN "file:" + cString
East or West HMG is the Best.
South or North HMG is worth.
...the possibilities are endless.

Post Reply