hi,
sorry, i mean Structure of Excel Sheet create by ADO
it did accept DATETIME in Structure for a Excel Sheet, but when XBROWSE / EDIT it fail
i have to change back to DATE to make it work again
Jimmy
hi,
sorry, i mean Structure of Excel Sheet create by ADO
it did accept DATETIME in Structure for a Excel Sheet, but when XBROWSE / EDIT it fail
i have to change back to DATE to make it work again
function TestXl()
local oCn, cSql, oRs, oRec
oCn := FW_OpenAdoExcelBook( TrueName( "some.xlsx" ) )
TRY
oCn:Execute( "DROP TABLE [TESTDT]" )
CATCH
END
TEXT INTO cSql
CREATE TABLE [testdt] (
[NAME] VARCHAR(20),
[JGDATE] DATE,
[TSTAMP] DATETIME
)
ENDTEXT
oCn:Execute( cSql )
oRs := FW_OpenRecordSet( oCn, "select * from [testdt]" )
oRs:AddNew( { "NAME", "JGDATE", "TSTAMP" }, { "Albert", Date() - 400, HB_DateTime() } )
oRs:MoveFirst()
oRec := TDataRow():New( oRs )
oRec:Edit()
oRs:Close()
oCn:Close()
return nil

PROCEDURE Dbf2ExcelDialog()
LOCAL oDlg, oGet, oBtn1, oBtn2, oBtn3, oFontDialog
LOCAL oProgress
STATIC cDbf
DEFINE DIALOG oDlg FROM 0, 0 TO 200, 320 + 100 PIXEL TITLE "Dbf2Excel" ;
ICON "A1MAIN" COLOR BFcolor, BGcolor
oProgress := TProgress() :New( 0, 1, oDlg, 0,,, .T., .F., 200 + 50 - 42, 3 )
oProgress:SetRange( 0, 100 )
oProgress:SetStep( 1 )
oProgress:SetPos( 0 )
// oProgress:hide()
@ 30, 10 GET oGet VAR cDbf SIZE 140 + 50, 15 PIXEL OF oDlg ;
FONT oFontDefault ;
COLOR BFcolor, BGcolor
@ 60, 010 BTNBMP oBtn1 SIZE 60, 30 PIXEL OF oDlg ;
FONT oFontDefault ;
PROMPT FWString( "&DBF" ) COLOR BFcolor, BGcolor CENTER ;
ACTION( cDbf := cGetFile( "DBF file (*.dbf)|*.dbf", "Select DBF" ), oGet:Refresh() )
oBtn1:bClrGrad := bGradient
@ 60, 075 BTNBMP oBtn2 SIZE 60, 30 PIXEL OF oDlg ;
FONT oFontDefault ;
PROMPT FWString( "&CodePage" ) COLOR BFcolor, BGcolor CENTER ;
ACTION( ChangeCodePage() )
oBtn2:bClrGrad := bGradient
@ 60, 090 + 50 BTNBMP oBtn3 SIZE 60, 30 PIXEL OF oDlg ;
FONT oFontDefault ;
PROMPT FWString( "&Go" ) COLOR BFcolor, BGcolor CENTER ;
ACTION( CursorWait(), Use_ADO_2Excel( cDbf, .T., oProgress ), CursorArrow(), oDlg:End() )
oBtn3:bClrGrad := bGradient
END DIALOG
ACTIVATE DIALOG oDlg ON INIT( CTRLS_COLORS( oDlg ) ) CENTER
RETURNSTATIC FUNCTION Use_ADO_2Excel( cDbf, lHeaders, oProgress )
LOCAL oCon
LOCAL oCat
LOCAL oRs
LOCAL cTable
LOCAL cQuery, i, iMax
LOCAL aDbfStruct
LOCAL nStart, nStop
LOCAL aClone
LOCAL nLenStruc, nLenSum := 0
LOCAL oError, lRet := .T.
LOCAL aFields := {}
LOCAL nEvery := 100
LOCAL nCount := 0
LOCAL nloop := 0
LOCAL _cVia := "DBFCDX"
DEFAULT lHeaders := .T.
IF EMPTY( cDbf )
cDbf := cGetFile( "DBF file (*.dbf)|*.dbf", "Select DBF" )
ENDIF
IF EMPTY( cDbf )
RETURN ( .f. )
ENDIF
cTable := LOWER( cFileNoExt( cDbf ) )
IF FILE( cTable + ".XLSB" )
FERASE( cTable + ".XLSB" )
ENDIF
try
oCon := TOleAuto() :New( "ADODB.Connection" )
oCon:Open( "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" + ;
cTable + ';Extended Properties="Excel 12.0;HDR=' + ;
IF( lHeaders, 'Yes";', 'No";' ) )
Catch oError
MsgInfo( oError:Description )
RETURN ( .f. )
END Try
MsgInfo( cTable + " : now create Structure " + CRLF + cDBF )
nStart := SECONDS()
SELECT 1
USE (cDBF) EXCLUSIVE // CODEPAGE SP_cWinCodepage() VIA _cVia ALIAS "IMPORT"
nEvery := INT( RECCOUNT() / 100 )
aDbfStruct := DBSTRUCT()
nLenStruc := LEN( aDbfStruct )
FOR i := 1 TO LEN( aDbfStruct )
AADD( aFields, aDbfStruct[ i ] [ DBS_NAME ] )
NEXT
cQuery := "CREATE TABLE " + cTable + " ( "
iMax := LEN( aDbfStruct )
i = 1
FOR i = 1 TO iMax
cQuery += aDbfStruct[ i, DBS_NAME ]
SbarText( aDbfStruct[ i ] [ DBS_NAME ] + CHR( 9 ) + aDbfStruct[ i, DBS_TYPE ] )
DO CASE
CASE aDbfStruct[ i, DBS_TYPE ] = "C"
IF aDbfStruct[ i ] [ DBS_LEN ] > 250
#ifdef Use_Ok_Excel
cQuery += " TEXT "
#else
cQuery += " MEMO "
#endif
ELSE
// cQuery += " VARCHAR(" + ALLTRIM( STR( aDbfStruct[ i, DBS_LEN ] ) ) + ") "
cQuery += " TEXT ( " + ALLTRIM( STR( aDbfStruct[ i, DBS_LEN ] ) ) + ") "
ENDIF
CASE aDbfStruct[ i, DBS_TYPE ] = "N"
#ifdef Use_Ok_Excel
IF aDbfStruct[ i, DBS_DEC ] = 0
cQuery += " INT "
ELSE
cQuery += " DOUBLE "
ENDIF
#else
cQuery += " NUMBER "
#endif
CASE aDbfStruct[ i, DBS_TYPE ] = "D"
// #ifdef Use_Ok_Excel
cQuery += " DATE "
// #else
// cQuery += " DATETIME "
// #endif
CASE aDbfStruct[ i, DBS_TYPE ] = "L"
#ifdef Use_Ok_Excel
cQuery += " BIT "
#else
cQuery += " LOGICAL "
#endif
CASE aDbfStruct[ i, DBS_TYPE ] = "M"
// IF lUseBlob = .T.
// cQuery += " bytea, "
// ELSE
// cQuery += " VARCHAR "
// cQuery += " TEXT "
cQuery += " MEMO "
// ENDIF
CASE aDbfStruct[ i, DBS_TYPE ] = "V"
// store as HEX String
cQuery += " bytea "
ENDCASE
IF i <> iMax
cQuery += ", "
ENDIF
NEXT
cQuery += " )"
fwlog cQuery
Try
oCon:Execute( cQuery )
Catch oError
CopyToClipboard( oError:Description )
// MsgInfo( oError:Description, cTable )
FW_ShowAdoError( oCon )
oCon:Close()
RETURN .F.
END try
oRs := FW_OpenRecordSet( oCon, cTable )
GO TOP
DO WHILE !EOF()
oRs:AddNew( aFields, GetRecordValue( aFields, aDbfStruct ) )
nCount ++
IF ( nCount % nEvery ) == 0
nloop ++
oProgress:SetPos( nloop )
SysRefresh()
ENDIF
SKIP
ENDDO
oRs:Close()
oCon:Close()
oRs := NIL
oCon := NIL
nStop := SECONDS()
SbarText( "" )
SbarText( "End: " + TIME() )
SbarText( "records in dbf: " + hb_ntos( LASTREC() ) )
SbarText( "imported recs: " + hb_ntos( nCount ) )
SbarText( "Sec " + Sec2HMS( nStop - nStart ) )
SbarText( "Rec/Sec " + hb_ntos( nCount / ( nStop - nStart ) ) )
SbarText( "" )
CLOSE ALL
oProgress:SetPos( 0 )
RETURN lRetSTATIC FUNCTION GetRecordValue( aFields, aDbfStruct )
LOCAL i, iMax, oField, u, c, d, aRet := {}
iMax := LEN( aFields )
FOR i := 1 TO iMax
u := FIELDGET( i )
DO CASE
CASE aDbfStruct[ i ] [ DBS_TYPE ] = "L"
IF u = .T.
u := 1
ELSE
u := 0
ENDIF
CASE aDbfStruct[ i ] [ DBS_TYPE ] = "D"
c := DTOC( u )
d := CTOD( c )
IF EMPTY( d )
u := TRANSFORM( "19000101", "@R 9999-99-99" )
ELSE
u := TRANSFORM( DTOS( FW_TToD( u ) ), "@R 9999-99-99" )
ENDIF
ENDCASE
AADD( aRet, u )
NEXT
// fwlog var2char( aRet )
RETURN aRet#include "FiveWin.ch"
#Define bGradient {| lInvert | If( lInvert, ;
{ { 1 / 3, nRGB( 255, 253, 222 ), nRGB( 255, 231, 151 ) }, ;
{ 2 / 3, nRGB( 255, 215, 84 ), nRGB( 255, 233, 162 ) } ;
}, ;
{ { 1 / 2, nRGB( 219, 230, 244 ), nRGB( 207 - 50, 221 - 25, 255 ) }, ;
{ 1 / 2, nRGB( 201 - 50, 217 - 25, 255 ), nRGB( 231, 242, 255 ) } ;
} ) }
ANNOUNCE RDDSYS // IDEM: ANNOUNCE FPTCDX
REQUEST OrdKeyNo, OrdKeyCount, OrdCreate, OrdKeyGoto
REQUEST DBFCDX, DBFFPT
STATIC oWnd
STATIC cDbf, BFcolor, BGcolor, OFONTDEFAULT, DBS_NAME, DBS_LEN, DBS_TYPE
FUNCTION Main()
BFcolor := CLR_BLACK
BGcolor := CLR_WHITE
RDDSETDEFAULT("DBFCDX")
RDDREGISTER( "DBFCDX", 1 )
SkinButtons()
Dbf2ExcelDialog()
RETURN NIL
PROCEDURE Dbf2ExcelDialog()
LOCAL oDlg, oGet, oBtn1, oBtn2, oBtn3, oFontDialog, oProgress
DEFINE FONT oFontDefault NAME "Courier New" SIZE 0, -16 // OF oWnd CHARSET 255
DEFINE DIALOG oDlg FROM 0, 0 TO 200, 320 + 100 PIXEL TITLE "Dbf2Excel" ;
ICON "A1MAIN" COLOR CLR_BLACK, CLR_WHITE
oDlg:lHelpIcon := .F.
oProgress := TProgress() :New( 0, 1, oDlg, 0,,, .T., .F., 200 + 50 - 42, 3 )
oProgress:SetRange( 0, 100 )
oProgress:SetStep( 1 )
oProgress:SetPos( 0 )
// oProgress:hide()
@ 30, 10 GET oGet VAR cDbf SIZE 140 + 50, 15 PIXEL OF oDlg ;
FONT oFontDefault ;
COLOR BFcolor, BGcolor
@ 60, 010 BTNBMP oBtn1 SIZE 60, 30 PIXEL OF oDlg ;
FONT oFontDefault ;
PROMPT FWString( "&DBF" ) COLOR BFcolor, BGcolor CENTER ;
ACTION( cDbf := cGetFile( "DBF file (*.dbf)|*.dbf", "Select DBF" ), oGet:Refresh() )
oBtn1:bClrGrad := bGradient
@ 60, 075 BTNBMP oBtn2 SIZE 60, 30 PIXEL OF oDlg ;
FONT oFontDefault ;
PROMPT FWString( "&CodePage" ) COLOR BFcolor, BGcolor CENTER ;
ACTION( ChangeCodePage() )
oBtn2:bClrGrad := bGradient
@ 60, 090 + 50 BTNBMP oBtn3 SIZE 60, 30 PIXEL OF oDlg ;
FONT oFontDefault ;
PROMPT FWString( "&Go" ) COLOR BFcolor, BGcolor CENTER ;
ACTION( CursorWait(), Use_ADO_2Excel( cDbf, .T., oProgress ), CursorArrow(), oDlg:End() )
oBtn3:bClrGrad := bGradient
// END DIALOG // QUE PASA?
ACTIVATE DIALOG oDlg ON INIT( CTRLS_COLORS( oDlg ) ) CENTER
oFontDefault:End()
RETURN NIL
STATIC FUNCTION Use_ADO_2Excel( cDbf, lHeaders, oProgress )
LOCAL oCon
LOCAL oCat
LOCAL oRs
LOCAL cTable
LOCAL cQuery, i, iMax
LOCAL aDbfStruct
LOCAL nStart, nStop
LOCAL aClone
LOCAL nLenStruc, nLenSum := 0
LOCAL oError, lRet := .T.
LOCAL aFields := {}
LOCAL nEvery := 100
LOCAL nCount := 0
LOCAL nloop := 0
LOCAL _cVia := "DBFCDX"
DEFAULT lHeaders := .T.
IF EMPTY( cDbf )
cDbf := cGetFile( "DBF file (*.dbf)|*.dbf", "Select DBF" )
ENDIF
IF EMPTY( cDbf )
RETURN ( .f. )
ENDIF
cTable := LOWER( cFileNoExt( cDbf ) )
IF FILE( cTable + ".XLSB" )
FERASE( cTable + ".XLSB" )
ENDIF
try
oCon := TOleAuto() :New( "ADODB.Connection" )
oCon:Open( "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" + ;
cTable + ';Extended Properties="Excel 12.0;HDR=' + ;
IF( lHeaders, 'Yes";', 'No";' ) )
Catch oError
MsgInfo( oError:Description )
RETURN ( .f. )
END Try
MsgInfo( cTable + " : now create Structure " + CRLF + cDBF )
nStart := SECONDS()
SELECT 1
USE (cDBF) EXCLUSIVE // CODEPAGE SP_cWinCodepage() VIA _cVia ALIAS "IMPORT"
nEvery := INT( RECCOUNT() / 100 )
aDbfStruct := DBSTRUCT()
nLenStruc := LEN( aDbfStruct )
FOR i := 1 TO LEN( aDbfStruct )
AADD( aFields, aDbfStruct[ i ] [ DBS_NAME ] )
NEXT
cQuery := "CREATE TABLE " + cTable + " ( "
iMax := LEN( aDbfStruct )
i = 1
FOR i = 1 TO iMax
cQuery += aDbfStruct[ i, DBS_NAME ]
SbarText( aDbfStruct[ i ] [ DBS_NAME ] + CHR( 9 ) + aDbfStruct[ i, DBS_TYPE ] )
DO CASE
CASE aDbfStruct[ i, DBS_TYPE ] = "C"
IF aDbfStruct[ i ] [ DBS_LEN ] > 250
#ifdef Use_Ok_Excel
cQuery += " TEXT "
#else
cQuery += " MEMO "
#endif
ELSE
// cQuery += " VARCHAR(" + ALLTRIM( STR( aDbfStruct[ i, DBS_LEN ] ) ) + ") "
cQuery += " TEXT ( " + ALLTRIM( STR( aDbfStruct[ i, DBS_LEN ] ) ) + ") "
ENDIF
CASE aDbfStruct[ i, DBS_TYPE ] = "N"
#ifdef Use_Ok_Excel
IF aDbfStruct[ i, DBS_DEC ] = 0
cQuery += " INT "
ELSE
cQuery += " DOUBLE "
ENDIF
#else
cQuery += " NUMBER "
#endif
CASE aDbfStruct[ i, DBS_TYPE ] = "D"
// #ifdef Use_Ok_Excel
cQuery += " DATE "
// #else
// cQuery += " DATETIME "
// #endif
CASE aDbfStruct[ i, DBS_TYPE ] = "L"
#ifdef Use_Ok_Excel
cQuery += " BIT "
#else
cQuery += " LOGICAL "
#endif
CASE aDbfStruct[ i, DBS_TYPE ] = "M"
// IF lUseBlob = .T.
// cQuery += " bytea, "
// ELSE
// cQuery += " VARCHAR "
// cQuery += " TEXT "
cQuery += " MEMO "
// ENDIF
CASE aDbfStruct[ i, DBS_TYPE ] = "V"
// store as HEX String
cQuery += " bytea "
ENDCASE
IF i <> iMax
cQuery += ", "
ENDIF
NEXT
cQuery += " )"
fwlog cQuery
Try
oCon:Execute( cQuery )
Catch oError
CopyToClipboard( oError:Description )
// MsgInfo( oError:Description, cTable )
FW_ShowAdoError( oCon )
oCon:Close()
RETURN .F.
END try
oRs := FW_OpenRecordSet( oCon, cTable )
GO TOP
WHILE .NOT. EOF()
SYSREFRESH()
oRs:AddNew( aFields, GetRecordValue( aFields, aDbfStruct ) )
nCount ++
IF ( nCount % nEvery ) == 0
nloop ++
oProgress:SetPos( nloop )
ENDIF
SKIP
ENDDO
oRs:Close()
oCon:Close()
oRs := NIL
oCon := NIL
nStop := SECONDS()
SbarText( "" )
SbarText( "End: " + TIME() )
SbarText( "records in dbf: " + hb_ntos( LASTREC() ) )
SbarText( "imported recs: " + hb_ntos( nCount ) )
SbarText( "Sec " + Sec2HMS( nStop - nStart ) )
SbarText( "Rec/Sec " + hb_ntos( nCount / ( nStop - nStart ) ) )
SbarText( "" )
CLOSE ALL
oProgress:SetPos( 0 )
RETURN lRet
STATIC FUNCTION GetRecordValue( aFields, aDbfStruct )
LOCAL i, iMax, oField, u, c, d, aRet := {}
iMax := LEN( aFields )
FOR i := 1 TO iMax
SYSREFRESH()
u := FIELDGET( i )
DO CASE
CASE aDbfStruct[ i ] [ DBS_TYPE ] = "L"
IF u = .T.
u := 1
ELSE
u := 0
ENDIF
CASE aDbfStruct[ i ] [ DBS_TYPE ] = "D"
c := DTOC( u )
d := CTOD( c )
IF EMPTY( d )
u := TRANSFORM( "19000101", "@R 9999-99-99" )
ELSE
u := TRANSFORM( DTOS( FW_TToD( u ) ), "@R 9999-99-99" )
ENDIF
ENDCASE
AADD( aRet, u )
NEXT
// fwlog var2char( aRet )
RETURN aRet
// By Giovanny Vecchi - TESTRAD.PRG aqui na minha pasta.
FUNCTION CTRLS_COLORS( f_oDlgContainer )
LOCAL lc_aCtrls := {}, lc_iFor := 0
LOCAL lc_aItemsRadio := {}
lc_aCtrls := f_oDlgContainer:aControls
FOR lc_iFor := 1 TO Len( lc_aCtrls )
IF ValType( lc_aCtrls[lc_iFor] ) == "O"
IF lc_aCtrls[lc_iFor]:ClassName() == "TRADIO"
aEval( lc_aCtrls[lc_iFor]:oRadMenu:aItems, ;
{|_oRadId|{ SetWindowTheme( _oRadId:hWnd, "", "" ), ;
_oRadId:SetColor( CLR_CYAN, CLR_WHITE ) } } )
ELSEIF lc_aCtrls[lc_iFor]:ClassName() == "TCHECKBOX"
// SetWindowTheme( lc_aCtrls[lc_iFor]:hWnd, "", "" )
// lc_aCtrls[lc_iFor]:SetColor( G_COLOR_SYS( 31 ), G_COLOR_SYS( 1 ) )
ENDIF
ENDIF
NEXT
RETURN NIL
FUNCTION CHANGECODEPAGE() // Jimmy send me this FUNCTION
RETURN NIL
FUNCTION SBARTEXT() // Jimmy send me this FUNCTION
RETURN NIL
FUNCTION COPYTOCLIPBOARD() // Jimmy send me this FUNCTION
RETURN NIL
FUNCTION SEC2HMS() // Jimmy send me this FUNCTION
RETURN NIL
// FIN / END - kapiabafwh@gmail.com#include "fivewin.ch"
function Main()
local oCn, cSql, oRs, oRec
local cFile := "test.xlsx"
loCAL cDbf := "customer.dbf"
local cTable, aStruct, aData, aCols
SET DATE GERMAN
SET CENTURY ON
FWNumFormat( "E", .t. )
SetGetColorFocus()
if !( File( cFile ) .and. File( cDbf ) )
? "Files do not exist"
return nil
endif
cTable := cFileNoExt( cDbf )
oCn := FW_OpenADOExcelBook( TrueName( cFile ) )
TRY
oCn:Execute( "DROP TABLE [" + cTable + "]" )
CATCH
END
USE ( cDbf ) NEW SHARED
aStruct := DBSTRUCT()
aCols := ArrTranspose( aStruct )[ 1 ]
cSql := FW_XLCreateTableSQL( cTable, aStruct )
oCn:Execute( cSql )
? "Table created"
oRs := FW_OpenRecordSet( oCn, "select * from [" + cTable + "]" )
XBROWSER FWAdoStruct( oRs ) TITLE "STRUCTURE"
MsgRun( "Adding Data", cTable, <||
aData := FW_DbfToArray()
AEval( aData, { |aVals,i| oRs:AddNew( aCols, aVals ) } )
return nil
> )
oRs:MoveFirst()
oRec := TDataRow():New( oRs )
oRec:Edit()
XBROWSER oRs TITLE cTable FASTEDIT AUTOFIT
oCn:Close()
return nil
//----------------------------------------------------------------------------//
function FW_XLCreateTableSQL( cName, aStruct )
local cSql := "CREATE TABLE " + cName + " ( "
local aCols := Array( Len( aStruct ) )
AEval( aStruct, <|aFld,i|
if i > 1
cSql += ", "
endif
cSql += "[" + aFld[ 1 ] + "] "
cSql += If( aFld[ 2 ] == "C", "VARCHAR(255)", ;
If( aFld[ 2 ] $ "DT=@", "DATE", ;
If( aFld[ 2 ] == "L", "LOGICAL", ;
If( aFld[ 2 ] $ "+N", "DOUBLE", "TEXT" ) ) ) )
return nil
> )
return cSql + " )"
//----------------------------------------------------------------------------//
Some points:
I prefer adopting the sql approach than using ADOX.
We need to be aware of the limitations of creating Excel sheets using ADO.
a) Whatever length we specify, all character columns are VarChar(255)
b) Whatever numeric datatype, like int, numeric(w,d), etc we specify the columns are finally double only.
c) Date fields accept both dates and datetime values.
d) Use field type "TEXT" for memo fields.
To have better control of column formatting we need to create Excel Sheets using Excel OLE.
ADO has these limitations.
We are going to make some necessary changes in xbrowse and other functions to accommodate the specific issues relating to Excel ADO Tables.
#include "fivewin.ch"
#include "adodef.ch"
function Main()
local oCn, cSql, oRs, oRec
local cFile := "test.xlsx"
loCAL cDbf := "customer.dbf"
local cTable, aStruct, aData, aCols
SET DATE GERMAN
SET CENTURY ON
FWNumFormat( "E", .t. )
SetGetColorFocus()
if !( File( cFile ) .and. File( cDbf ) )
? "Files do not exist"
return nil
endif
cTable := cFileNoExt( cDbf )
oCn := FW_OpenADOExcelBook( TrueName( cFile ) )
TRY
oCn:Execute( "DROP TABLE [" + cTable + "]" )
CATCH
END
USE ( cDbf ) NEW SHARED
aStruct := DBSTRUCT()
aCols := ArrTranspose( aStruct )[ 1 ]
if MsgNoYes( "Use ADOX?" )
FW_ADOX_CreateExcelTable( oCn, cTable, aStruct )
else
cSql := FW_XLCreateTableSQL( cTable, aStruct )
oCn:Execute( cSql )
endif
? "Table created"
oRs := FW_OpenRecordSet( oCn, "select * from [" + cTable + "]" )
XBROWSER FWAdoStruct( oRs ) TITLE "STRUCTURE"
MsgRun( "Adding Data", cTable, <||
aData := FW_DbfToArray()
AEval( aData, { |aVals,i| oRs:AddNew( aCols, DateCheck( aVals ) ) } )
return nil
> )
oRs:MoveFirst()
oRec := TDataRow():New( oRs )
oRec:Edit()
XBROWSER oRs TITLE cTable FASTEDIT AUTOFIT
oCn:Close()
return nil
//----------------------------------------------------------------------------//
function FW_XLCreateTableSQL( cName, aStruct )
local cSql := "CREATE TABLE " + cName + " ( "
local aCols := Array( Len( aStruct ) )
AEval( aStruct, <|aFld,i|
if i > 1
cSql += ", "
endif
cSql += "[" + aFld[ 1 ] + "] "
cSql += If( aFld[ 2 ] == "C", "VARCHAR(255)", ;
If( aFld[ 2 ] $ "DT=@", "DATE", ;
If( aFld[ 2 ] == "L", "LOGICAL", ;
If( aFld[ 2 ] $ "+N", "DOUBLE", "TEXT" ) ) ) )
return nil
> )
return cSql + " )"
//----------------------------------------------------------------------------//
function FW_ADOX_CreateExcelTable( oCn, cTable, aStruct )
local oCat := CreateObject( "ADOX.Catalog" )
local oTable, aFld, n, cType
local oCol, oCol2
local nType, nLen
oCat:ActiveConnection := oCn
cTable := Lower( cTable )
oTable := CreateObject( "ADOX.Table" )
oTable:Name := cTable
AEval( aStruct, <|aFld,i|
local nType := ;
If( aFld[ 2 ] == "C", adVarWChar, ;
If( aFld[ 2 ] $ "DT=@", adDate, ;
If( aFld[ 2 ] == "L", adBoolean, ;
If( aFld[ 2 ] $ "+N", adDouble, adLongVarWChar ) ) ) )
oTable:Columns:Append( aFld[ 1 ], nType )
if i == 7
oCat:Tables:Append( oTable )
oTable := oCat:Tables( cTable )
endif
return nil
> )
return nil
//----------------------------------------------------------------------------//
function DateCheck( aVals )
AEval( aVals, { |u,i| If( ValType( u ) $ "DT" .and. u < {^ 1900/01/01 }, ;
aVals[ i ] := nil, nil ) } )
return aVals
//----------------------------------------------------------------------------//nageswaragunupudi wrote:Please try:your Sample work great ... but it NEED existing *.XLSx
karinha wrote:COMPLETE the example correctly please! You are no longer an apprentice.I apologize but the CODE is still under Construction
FUNCTION CHANGECODEPAGE ( ) // Jimmy send me this FUNCTIONFUNCTION SBARTEXT(cText) // Jimmy send me this FUNCTIONit are all Message so use
FUNCTION COPYTOCLIPBOARD ( ) // Jimmy send me this FUNCTIONnot need, just copy cText to Clipboard
FUNCTION CopyToClipboard( cText )
LOCAL oClip := TClipBoard() :New()
IF oClip:Open()
oClip:SetText( cText )
oClip:Close()
ENDIF
oClip:End()
RETURN nilFUNCTION SEC2HMS() // Jimmy send me this FUNCTIONnot need, just to convert Seconds to HHMMSS
FUNCTION Sec2HMS( nSec )
LOCAL cHHMMSS := ""
LOCAL nInt := 0
LOCAL nHH := 0
LOCAL nMM := 0
LOCAL nSS := 0
LOCAL nDays := 0
IF nSec >= 60 * 60 * 24
nDays := INT( nSec / ( 60 * 60 * 24 ) )
nSec := nSec - ( nDays * ( 60 * 60 * 24 ) )
ENDIF
IF nSec >= 3600
nHH := INT( nSec / 60 / 60 )
nInt := ( nSec - ( nHH * 60 * 60 ) ) / 60
ELSE
nInt := nSec / 60
ENDIF
nMM := INT( nInt )
nSS := INT( ( nInt - nMM ) * 60 )
// hm ... k"nnte das sein ?
//
// IF nSS > 99
// nSS := 99
// ENDIF
cHHMMSS := IF( nHH > 0, STRZERO( nHH, 2 ) + ":", "00:" ) + ;
IF( nMM > 0, STRZERO( nMM, 2 ) + ":", "00:" ) + ;
STRZERO( nSS, 2 )
RETURN cHHMMSSyour Sample work great ... but it NEED existing *.XLSxYes.
i have try to use a "empty" *.XLSx but got Error : Table does not have expected Structure :cry:
so i need to create Table before i can go "your Way"
FW_CopyToClipboard( data, [nFormat] ) --> lSuccessSecToTime( nSecs, [lMilliSecs = .f.] ) --> "hh:mm:ss[.ddd]"Mr. Karinha
Do you know where can we get the famous TExcel class?
nageswaragunupudi wrote:There are built-in functions in (x)Harbour already for many years.sorry i´m still a Newbie and do not know what Fivewin already have or can do
I see no point in writing and maintaining our own code.
nageswaragunupudi wrote: Yes.i have change you last CODE to "create" Table without "existing" *.XLSB
We need an existing valid XLSX file to start with.
Obviously because ADODB connection can be connected to an existing valid xlsx file, can not connect to "nothing".
function Rao_SQL2(cDbf)
local oCn, cSql, oRs, oRec
* local cFile := "test.xlsx"
* loCAL cDbf := "customer.dbf"
local cTable, aStruct, aData, aCols, oError
LOCAL lHeaders := .T.
SET DATE GERMAN
SET CENTURY ON
FWNumFormat( "E", .t. )
SetGetColorFocus()
* if !( File( cFile ) .and. File( cDbf ) )
* ? "Files do not exist"
* return nil
* endif
cTable := cFileNoExt( cDbf )
IF FILE( cTable + ".XLSB" )
FERASE( cTable + ".XLSB" )
ENDIF
FW_SetUnicode( .F. ) // have to use .F. for German Umlaute
* oCn := FW_OpenADOExcelBook( TrueName( cFile ) )
* TRY
* oCn:Execute( "DROP TABLE [" + cTable + "]" )
* CATCH
* END
try
oCn := TOleAuto() :New( "ADODB.Connection" )
oCn:Open( "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" + ;
cTable + ';Extended Properties="Excel 12.0;HDR=' + ;
IF( lHeaders, 'Yes";', 'No";' ) )
Catch oError
MsgInfo( oError:Description )
RETURN ( .f. )
END Try
* USE ( cDbf ) NEW SHARED
USE (cDBF) EXCLUSIVE CODEPAGE SP_cWinCodepage() // VIA _cVia ALIAS "IMPORT"
aStruct := DBSTRUCT()
aCols := ArrTranspose( aStruct )[ 1 ]
* if MsgNoYes( "Use ADOX?" )
* FW_ADOX_CreateExcelTable( oCn, cTable, aStruct ) // does crash ?
* else
cSql := FW_XLCreateTableSQL2( cTable, aStruct )
oCn:Execute( cSql )
* endif
* ? "Table created"
oRs := FW_OpenRecordSet( oCn, "select * from [" + cTable + "]" )
* work, just need for Control
* XBROWSER FWAdoStruct( oRs ) TITLE "STRUCTURE"
MsgRun( "Adding Data", cTable, <||
aData := FW_DbfToArray()
AEval( aData, { |aVals,i| oRs:AddNew( aCols, DateCheck( aVals ) ) } )
return nil
> )
oRs:MoveFirst()
* oRec := TDataRow():New( oRs )
* oRec:Edit() // see German Umlaute
XBROWSER oRs TITLE cTable FASTEDIT AUTOFIT
oRs:Close()
oCn:Close()
IF USED()
CLOSE
ENDIF
return nil