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
RETURN
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
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 lRet
STATIC 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 + " )"
//----------------------------------------------------------------------------//
#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:
karinha wrote:COMPLETE the example correctly please! You are no longer an apprentice.
FUNCTION CHANGECODEPAGE ( ) // Jimmy send me this FUNCTION
FUNCTION SBARTEXT(cText) // Jimmy send me this FUNCTION
FUNCTION COPYTOCLIPBOARD ( ) // Jimmy send me this FUNCTION
FUNCTION CopyToClipboard( cText )
LOCAL oClip := TClipBoard() :New()
IF oClip:Open()
oClip:SetText( cText )
oClip:Close()
ENDIF
oClip:End()
RETURN nil
FUNCTION SEC2HMS() // Jimmy send me this FUNCTION
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 cHHMMSS
your Sample work great ... but it NEED existing *.XLSx
i have try to use a "empty" *.XLSx but got Error : Table does not have expected Structure
so i need to create Table before i can go "your Way"
FW_CopyToClipboard( data, [nFormat] ) --> lSuccess
SecToTime( nSecs, [lMilliSecs = .f.] ) --> "hh:mm:ss[.ddd]"
nageswaragunupudi wrote:There are built-in functions in (x)Harbour already for many years.
I see no point in writing and maintaining our own code.
nageswaragunupudi wrote:Yes.
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
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: No registered users and 63 guests