DBF to Excel Sheet, without Excel, using ADO ?

[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

[nageswaragunupudi]

This is the program I tested just now.

Code: Select all  Expand view

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
 

DateTime works

[Jimmy]

hi,

thx for Answer and Sample

a.) i got Error that "some.xlsx" does not exist when use FW_OpenAdoExcelBook()
i have use another *.XLSx and rename it to "some.xlsx"

b.) now i got into edit and press "new" an begin to "fill" it
when press "save" it "jump" to DATE FIELD where i input 01/01/01

c.) there is no "[testdt]" (or testdt*.*) create

---

i close Sample and want to open "some.xlsx" with Excel but it fail with Error


i use my "ADO Reader" and open "some.xlsx" but it is my "old XLSx" which i have rename

[Jimmy]

Code: Select all  Expand view

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

Code: Select all  Expand view

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

Code: Select all  Expand view

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

[karinha]

// C:\FWH..\SAMPLES\JIMMYADO.PRG

Jimmy, COMPLETE the example correctly please! You are no longer an apprentice.

Code: Select all  Expand view

#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
 

Regards, saludos.

[nageswaragunupudi]

Please try:

Code: Select all  Expand view

#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 + " )"

//----------------------------------------------------------------------------//
 

[nageswaragunupudi]

Some points:
1. I prefer adopting the sql approach than using ADOX.
2. 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.

[nageswaragunupudi]

This is an enhanced version.
There is an option to use ADOX of SQL to create the table.
Both options work alike.
Also used datecheck necessary for MS products.

Code: Select all  Expand view

#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

//----------------------------------------------------------------------------//
 

[Jimmy]

hi,

Please try:

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"

[Jimmy]

hi,

COMPLETE the example correctly please! You are no longer an apprentice.

I apologize but the CODE is still under Construction

i just want to show Way i have try without make a "full-working-Sample"

Code: Select all  Expand view

FUNCTION CHANGECODEPAGE  (  )   // Jimmy send me this FUNCTION

please use "your" Codepage like
RETURN "DEWIN"

FUNCTION SBARTEXT(cText) // Jimmy send me this FUNCTION

it are all Message so use
FWLOG cText

FUNCTION COPYTOCLIPBOARD ( ) // Jimmy send me this FUNCTION

not need, just copy cText to Clipboard

Code: Select all  Expand view

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

not need, just to convert Seconds to HHMMSS

Code: Select all  Expand view

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

[nageswaragunupudi]

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"

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

[nageswaragunupudi]

A few suggestions:

1) Instead of your CopyToClipBoard() fuction, we recommend using

Code: Select all  Expand view

FW_CopyToClipboard( data, [nFormat] ) --> lSuccess

nFormat can be omitted and is mostly guessed correctly by the function.

2) Sec2HMS:
There are built-in functions in (x)Harbour already for many years.
I see no point in writing and maintaining our own code.
We can use:

Code: Select all  Expand view

SecToTime( nSecs, [lMilliSecs = .f.] ) --> "hh:mm:ss[.ddd]"

[nageswaragunupudi]

Mr. Karinha

Do you know where can we get the famous TExcel class?

[Jimmy]

hi,

There are built-in functions in (x)Harbour already for many years.
I see no point in writing and maintaining our own code.

sorry i´m still a Newbie and do not know what Fivewin already have or can do

so i often use my old Xbase++ CODE which also work under harbour

[Jimmy]

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

i have change you last CODE to "create" Table without "existing" *.XLSB

Code: Select all  Expand view

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

it is Quick & Dirty but it seems to work this Way