Page 2 of 4
Re: DBF To Excel
Posted: Fri Mar 27, 2009 2:57 pm
by sudip
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
Re: DBF To Excel
Posted: Mon Mar 30, 2009 5:32 am
by swapan
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.
Re: DBF To Excel
Posted: Mon Mar 30, 2009 10:55 am
by sudip
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
Please advise me how to improve the code as before
With best regards.
Sudip
Re: DBF To Excel
Posted: Mon Mar 30, 2009 1:03 pm
by mol
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)
Re: DBF To Excel
Posted: Mon Mar 30, 2009 4:45 pm
by sudip
Hi Marek,
Is my latest code still buggy?
Regards.
Sudip
Re: DBF To Excel
Posted: Mon Mar 30, 2009 5:25 pm
by sudip
Hi,
HMG 2.7.0 has new System object. Using this handling Clipboard is very easy.
I also changed my code. My previous code:
Modified code:
Thank you Roberto Lopez.
With best regards.
Sudip
Re: DBF To Excel
Posted: Tue Mar 31, 2009 6:55 am
by mol
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?
Re: DBF To Excel
Posted: Tue Mar 31, 2009 7:26 am
by mol
So, simple function oExcel:SaveAs(...) doesn't work too.
I want to add that example which works ok, uses xharbour and bcc55.
Re: DBF To Excel
Posted: Tue Mar 31, 2009 7:42 am
by Rathinagiri
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")
Re: DBF To Excel
Posted: Tue Mar 31, 2009 7:46 am
by Rathinagiri
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