Abrir arquivo do excel

bencz · Mensagem por **bencz** » 27 Mar 2014 10:20

Olá, alguém sabe como posso ler arquivos do Excel ( *.xls ou *.xlsx ), com o harbour ou xHb ??

Pablo César · Mensagem por **Pablo César** » 27 Mar 2014 10:31

En Minigui tem este exemplo C:\MiniGUI\SAMPLES\Advanced\ReadXLS\readxls.prg

/*
 * HMG ReadXLS Demo
 * Contributed by Isma Elias <farfa890@gmail.Com>
 */

#include "MiniGUI.ch"

#define NTrim( n ) LTRIM( STR( n, IF( n == INT( n ), 0, 2 ) ) )

Static aNamis   := {}
Static aFila    := {}
Static aWitis   := {}
Static aHojita  := {}

Static nWcrt    := 0
Static nHcrt    := 0

Function Main()

    nWcrt    := GetDesktopWidth()
    nHcrt    := GetDesktopHeight()-28

    DEFINE WINDOW winmain ;
        AT 0,0 WIDTH nWcrt HEIGHT nHcrt ;
        TITLE 'LEER UN EXCEL !!!! ' ;
        MAIN

        @050,001 GRID Grid_1 WIDTH nWcrt-03 HEIGHT nHcrt-100 ;
                 FONT "Ms Sans Serif" SIZE 09 ;
                 HEADERS { "" }    ;
                 WIDTHS { 100 }   ;
                 ITEMS  { { "" } };
                 VALUE  1

        DEFINE BUTTON cmdxls
            ROW 015
            COL 005
            WIDTH  98
            HEIGHT 24
            CAPTION "&Abrir XLS"
            FONTNAME "Ms Sans Serif"
            FONTSIZE 9
            ACTION FAR_OpenXLS()
            FLAT .T.
        END BUTTON

    END WINDOW

    winmain.Maximize()

    ACTIVATE WINDOW winmain

Return Nil


Static Function FAR_OpenXLS()

     LOCAL ccFile

     if EMPTY(ccFile) .or. ccFile==NIL .or. LEN(ccFile)=0 .or. !file(ccFile)
        ccFile := getfile({{"Archivos excel  (*.xls)","*.xls"}},"Seleccione un archivo excel",GetCurrentFolder(),.f.)
     endif

     if EMPTY(ccFile) .or. ccFile==NIL .or. LEN(ccFile)=0 .or. !file(ccFile)
        return nil
     endif

     Load_XLS_CLI( ccFile )


Return Nil


Static Function Load_XLS_CLI( cArchivo )

     LOCAL nFilas   := 0
     LOCAL nColumns := 0
     LOCAL nnColumn := 0
     LOCAL nuColumn
     LOCAL ccValue
     LOCAL i        := 0
     LOCAL j        := 0

     LOCAL oExcel   as Object
     LOCAL oWorkBook
     LOCAL oHoja
     LOCAL ccNameIs := ""

     LOCAL NoSale  := TRUE
     LOCAL nnWiti  := 0
     LOCAL aTypes  AS ARRAY

     oExcel := TOleAuto():New( "Excel.Application" )
     IF  oExcel == nil
          MsgStop('Excel no está instalado!','Error')
          RETURN Nil
     Endif

     oWorkBook := oExcel:WorkBooks:Open( cArchivo )

     oExcel:Sheets(1):Select()
     oHoja := oExcel:ActiveSheet()
     oExcel:Visible       := .F.     // <---- No Mostrar
     oExcel:DisplayAlerts := .F.     // <---- esta elimina mensajes
     //
     ************** LOOP LECTURA PLANILLA EXCEL ******************
     //
     //------------ Averiguo Cantida de Filas    ------------------
     //
     nFilas    := oHoja:UsedRange:Rows:Count()
     //
     //------------ Averiguo Cantida de Columnas ------------------
     //
     nnColumn := 0
     //
     aNamis  := {}
     //
     i := 0
     nuColumn := 0

     nColumns := Len( getProperty( "winmain", "Grid_1", "Item", 1 ) )

     DO WHILE nColumns != 0
         winmain.Grid_1.DeleteColumn( nColumns )
         nColumns--
     ENDDO

     Do While NoSale

        i := i + 1

        ccValue := AnyToString( oHoja:cells(2,i):value )
        nnWiti := GetLenColumn( LEN( ccValue )  )

	ccNameIs := AnyToString( oHoja:cells(01, i):value )
        IF EMPTY( ccNameIs ) .or. LEN( ccNameIs ) = 0 .or. ccNameIs = ' '

           nuColumn := i - 1
           NoSale := FALSE

        ELSE

           winmain.Grid_1.AddColumn( i, ccNameIs, nnWiti, 0 )
           Do Events

           AADD(aNamis, ccNameIs )
           AADD(aWitis, 120)
           nnColumn := i
        ENDIF

     EndDo
     //
     IF  nuColumn <> nnColumn

         MsgInfo("nuColumn " + str(nuColumn) +  " nnColumn " + str(nnColumn))
     ENDIF
     //
     //------------------------------------------------------------
     //
     aFila  := {}
     aTypes := {}
     //
     FOR i=2 TO nFilas Step 1

          FOR j=1 TO nnColumn Step 1

             ccValue := AnyToString( oHoja:cells(i,j):value )
             AADD(aFila, ccValue )
             AADD(aTypes, "C")

          NEXT j

          winmain.Grid_1.addItem( ItemChar(aFila, aTypes) )

          AADD(aHojita, aFila )
          aFila  := {}
          aTypes := {}
          Do Events

     Next i

     oExcel:DisplayAlerts := .F. // <---- esta elimina mensajes
     oWorkBook:Close()
     oExcel:Quit()

     oWorkBook := NIL
     oHoja := NIL
     oExcel := NIL

     winmain.title := cArchivo
     Release oWorkBook
     Release oHoja
     Release oExcel

RETURN Nil

*----------------------------------------------------------------------*
FUNCTION ItemChar(aLine, aType)
*----------------------------------------------------------------------*

    LOCAL aRet:={}, x:=0, l:=0
    aRet:=array( len(aLine) )
    l:=len(aRet)
    FOR x:=1 TO l
        do case
        case aType[x]=="N"
             aRet[x]:=NTrim(aLine[x])
        case aType[x]=="D"
             aRet[x]:=dtoc(aLine[x])
        case aType[x]=="L"
             aRet[x]:=iif(aLine[x], "TRUE", "FALSE")
        otherwise
             aRet[x]:=aLine[x]
        endcase
    NEXT

RETURN aRet


FUNCTION AnyToString(csValue)

   LOCAL ccValor := ""
   LOCAL cdate
   LOCAL cFormatoDaData := set(4)

   SET DECIMALS   TO 0

   DO CASE
   CASE Valtype(csValue) == "N"
        ccValor := AllTrim(Str(csValue))

   CASE Valtype(csValue) == "D"
        IF !Empty(csValue)
           cdate := dtos(csValue)
           ccValor := substr(cDate,1,4) + "-" + substr(cDate,5,2) + "-" + substr(cDate,7,2)
        ELSE
           ccValor := ""
        ENDIF
   CASE Valtype(csValue) == "T"
        IF !Empty(csValue)
           cdate := dtos(csValue)
           ccValor := substr(cDate,1,4) + "-" + substr(cDate,5,2) + "-" + substr(cDate,7,2)
        ELSE
           ccValor := ""
        ENDIF

   CASE Valtype(csValue) $ "CM"
        IF Empty( csValue)
           ccValor=""
        ELSE
           ccValor := "" + csValue+ ""
        ENDIF

   CASE Valtype(csValue) == "L"
        ccValor := AllTrim(Str(iif(csValue == .F., 0, 1)))

   OTHERWISE
        ccValor := ""       // NOTE: Here we lose csValues we cannot convert

   ENDCASE

RETURN( ccValor )


FUNCTION GetLenColumn( nnLen )

    LOCAL nnValor := 120
    IF nnLen < 6
       nnValor := 70
    ELSEIF nnLen < 10
       nnValor := 110
    ELSEIF nnLen < 20
       nnValor := 140
    ELSEIF nnLen < 40
       nnValor := 240
    ELSE
       nnValor := 380
    ENDIF

RETURN( nnValor )

bencz · Mensagem por **bencz** » 27 Mar 2014 10:33

Jovem, existe alguma forma, sem utilizar OLE ?

Pablo César · Mensagem por **Pablo César** » 27 Mar 2014 10:40

bencz escreveu:Jovem, existe alguma forma, sem utilizar OLE ?

Jovem ? kkkk (você que tem 21 aninhos...) kkkk

Veja esta outra dica: https://pctoledo.org/forum/viewto ... 240#p86240

Também tem este outro: https://pctoledo.org/forum/viewto ... 576#p86576

bencz · Mensagem por **bencz** » 27 Mar 2014 13:06

Oloco, JOVEM haha

BOm, ai que está o problema, vamos ver, tenho uma maquina que não possui o Excel instalado, e o BrOffice instalado, e vamos ainda tratar do caso mais extremo, ele não pode instar o office.
Com C# utilizo uma lib chamada ExcelReader, e com C++ utilizo uma outra lib, tentei utilizar ela com o xHB/HB e nada certo!!!

Então, fica a minha duvida, se com xHB ou HB tem como ler um arquivo excel sem utilizar OLE!

Essa lib: http://www.libxl.com/ tem suporte para xBase, inclusive, tem um exemplo nela de como utilizar com xBase...

Pablo César · Mensagem por **Pablo César** » 27 Mar 2014 13:18

O problema dessa lib que é paga...

bencz · Mensagem por **bencz** » 27 Mar 2014 14:22

Também tem esse GRANDE PROBLEMA!!!

Mensagem por **JoséQuintas** » 02 Abr 2014 22:27

Só usar ADO, e aí pode abrir Excel, Access, MySql, Postgress, Oracle, e tudo mais.

Tinha até esquecido: pode até usar ADS Local, e usar comando SQL com DBFs.

bencz · Mensagem por **bencz** » 03 Abr 2014 08:50

AI q tah jovem, usar o Ado tranquilo, mas vamos supor o caso extremo, que o usuario não tenha Office instalado na maquina, nem o Br Office, complica em!

cruz_brasil · Mensagem por **cruz_brasil** » 03 Abr 2014 08:59

Bom dia.
Não sei se vai te servir, mas eu já usei assim:

Código: Selecionar todos

LOCAL oExcel, oSheet
LOCAL cARQ:='arquivo.xls'

TRY
   oExcel := xhb_GetActiveObject( "Excel.Application" )
CATCH
   TRY
      oExcel := xhb_CreateObject( "Excel.Application" )
   CATCH
      ? "Não foi possivel localizar o Excel instalado"
      oExcel:=NIL
   END
END
IF oExcel=NIL
   RETURN(.F.)
ENDIF

TRY
   oExcel:WorkBooks:Add()
CATCH
   ?"O Sistema não conseguiu iniciar um sessão do excel para fazer a exportação. Favor fechar todas as janelas do excel e tentar novamente."
   oExcel:=Nil
END
IF oExcel=NIL
   RETURN(.F.)
ENDIF

oSheet = oExcel:Sheets(1)

WITH OBJECT oSheet
   :Name := 'GRUPOS'

   // Titulos
   :Cells(01,01):Value = 'CodigoGrupo'
   :Cells(01,02):Value = 'CodigoGrupoPai'
   :Cells(01,03):Value = 'Descricao'

   // Celulas
   FOR mI:=1 TO LEN(aGRU)
      :Cells(mI+1,01):NumberFormat := '0'
      :Cells(mI+1,01):Value := aGRU[mI,1]
      
      :Cells(mI+1,02):NumberFormat := '0'
      :Cells(mI+1,02):Value := aGRU[mI,2]
      
      :Cells(mI+1,03):NumberFormat := '@'
      :Cells(mI+1,03):Value := aGRU[mI,3]
      
   NEXT
   :Columns:AutoFit()
END

IF FILE(cARQ)
   FERASE(cARQ)
ENDIF

oExcel:ActiveWorkBook:SaveAs(cARQ,50)

oExcel:Visible := .t.
oExcel:=NIL
oSheet:=NIL
Release oExcel
Release oSheet

bencz · Mensagem por **bencz** » 03 Abr 2014 09:04

Sim sim, isso é OLE!

Mas estou pensando apenas no caso extremo, praticamente certeza que o usuario final venha a ter instalado em sua maquina o Br Office ou o Office...
Tem um exemplo na contrib do harbour bem legal, que mostra como trabalhar com os 2 casos:

https://github.com/harbour/core/blob/ma ... ts/ole.prg

Pablo César · Mensagem por **Pablo César** » 03 Abr 2014 09:25

bencz escreveu:Tem um exemplo na contrib do harbour bem legal, que mostra como trabalhar com os 2 casos:

https://github.com/harbour/core/blob/ma ... ts/ole.prg

Eu não consegui acessar ao clicar, mas obtive pelo cache e assim disponibilizo aqui pra quem interessar:

Código: Selecionar todos

/*
 * Harbour Project source code
 *
 * hbole library demo/test code
 *
 * Copyright 2007 Enrico Maria Giordano e.m.giordano at emagsoftware.it
 * Copyright 2009 Mindaugas Kavaliauskas <dbtopas at dbtopas.lt>
 * Copyright 2008 Viktor Szakats (vszakats.net/harbour)
 *    Exm_CDO(), Exm_OOOpen(), Exm_CreateShortcut()
 *
 * www - http://harbour-project.org
 *
 */

#require "hbwin"

PROCEDURE Main()

   LOCAL nOption

   CLS

   DO WHILE .T.
      ? ""
      ? "Select OLE test:"
      ? "1) MS Excel"
      ? "2) MS Word"
      ? "3) MS Outlook (1)"
      ? "4) MS Outlook (2)"
      ? "5) Internet Explorer"
      ? "6) OpenOffice Calc"
      ? "7) OpenOffice Writer"
      ? "8) OpenOffice Open"
      ? "9) Send mail via CDO"
      ? "a) Read ADODB table"
      ? "b) SOAP Toolkit client"
      ? "c) PocketSOAP client"
      ? "d) Internet Explorer with callback"
      ? "e) Create shortcut"
      ? "0) Quit"
      ? "> "

      nOption := Inkey( 0 )
      ?? hb_keyChar( nOption )

      IF     nOption == hb_keyCode( "1" )
         Exm_MSExcel()
      ELSEIF nOption == hb_keyCode( "2" )
         Exm_MSWord()
      ELSEIF nOption == hb_keyCode( "3" )
         Exm_MSOutlook()
      ELSEIF nOption == hb_keyCode( "4" )
         Exm_MSOutlook2()
      ELSEIF nOption == hb_keyCode( "5" )
         Exm_IExplorer()
      ELSEIF nOption == hb_keyCode( "6" )
         Exm_OOCalc()
      ELSEIF nOption == hb_keyCode( "7" )
         Exm_OOWriter()
      ELSEIF nOption == hb_keyCode( "8" )
         Exm_OOOpen()
      ELSEIF nOption == hb_keyCode( "9" )
         Exm_CDO()
      ELSEIF nOption == hb_keyCode( "a" )
         Exm_ADODB()
      ELSEIF nOption == hb_keyCode( "b" )
         Exm_SOAP()
      ELSEIF nOption == hb_keyCode( "c" )
         Exm_PocketSOAP()
      ELSEIF nOption == hb_keyCode( "d" )
         Exm_IExplorer2()
      ELSEIF nOption == hb_keyCode( "e" )
         Exm_CreateShortcut()
      ELSEIF nOption == hb_keyCode( "0" )
         EXIT
      ENDIF
   ENDDO

   RETURN

STATIC PROCEDURE Exm_MSExcel()

   LOCAL oExcel, oWorkBook, oWorkSheet, oAS
   LOCAL nI, nCount

   IF ( oExcel := win_oleCreateObject( "Excel.Application" ) ) != NIL

      oWorkBook := oExcel:WorkBooks:Add()

      // Enumerator test
      FOR EACH oWorkSheet IN oWorkBook:WorkSheets
         ? oWorkSheet:Name
      NEXT

      // oWorkBook:WorkSheets is a collection
      nCount := oWorkBook:WorkSheets:Count()

      // Elements of collection can be accessed using :Item() method
      FOR nI := 1 TO nCount
         ? oWorkBook:WorkSheets:Item( nI ):Name
      NEXT

      // OLE also allows to access collection elements by passing
      // indices to :Worksheets property
      FOR nI := 1 TO nCount
         ? oWorkBook:WorkSheets( nI ):Name
      NEXT

      oAS := oExcel:ActiveSheet()

      // Set font for all cells
      oAS:Cells:Font:Name := "Arial"
      oAS:Cells:Font:Size := 12

      oAS:Cells( 1, 1 ):Value := "OLE from Harbour"
      oAS:Cells( 1, 1 ):Font:Size := 16

      // oAS:Cells( 1, 1 ) is object, but oAS:Cells( 1, 1 ):Value has value of the cell
      ? "Object valtype:", ValType( oAS:Cells( 1, 1 ) ), "Value:", oAS:Cells( 1, 1 ):Value

      oAS:Cells( 3, 1 ):Value := "String:"
      oAS:Cells( 3, 2 ):Value := "Hello, World!"

      oAS:Cells( 4, 1 ):Value := "Numeric:"
      oAS:Cells( 4, 2 ):Value := 1234.56
      oAS:Cells( 4, 3 ):Value := oAS:Cells( 4, 2 ):Value
      oAS:Cells( 4, 4 ):Value := oAS:Cells( 4, 2 ):Value
      oAS:Cells( 4, 3 ):Value *= 2
      oAS:Cells( 4, 2 ):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:Cells( 7, 1 ):Value := "Timestamp:"
      oAS:Cells( 7, 2 ):Value := hb_DateTime()

      // Some formatting
      oAS:Columns( 1 ):Font:Bold := .T.
      oAS:Columns( 2 ):HorizontalAlignment := - 4152  // xlRight

      oAS:Columns( 1 ):AutoFit()
      oAS:Columns( 2 ):AutoFit()
      oAS:Columns( 3 ):AutoFit()
      oAS:Columns( 4 ):AutoFit()

      oAS:Cells( 3, 2 ):Font:ColorIndex := 3  // red

      oAS:Range( "A1:B1" ):HorizontalAlignment := 7
      oAS:Range( "A3:A7" ):Select()

      oExcel:Visible := .T.

      oExcel:Quit()
   ELSE
      ? "Error: MS Excel not available. [" + win_oleErrorText() + "]"
   ENDIF

   RETURN

STATIC PROCEDURE Exm_MSWord()

   LOCAL oWord, oText

   IF ( oWord := win_oleCreateObject( "Word.Application" ) ) != NIL

      oWord:Documents:Add()

      oText := oWord:Selection()

      oText:Text := "OLE from Harbour" + hb_eol()
      oText:Font:Name := "Arial"
      oText:Font:Size := 48
      oText:Font:Bold := .T.

      oWord:Visible := .T.
      oWord:WindowState := 1 /* Maximize */
   ELSE
      ? "Error. MS Word not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_MSOutlook()

   LOCAL oOL, oList

   IF ( oOL := win_oleCreateObject( "Outlook.Application" ) ) != NIL
      oList := oOL:CreateItem( 7 /* olDistributionListItem */ )
      oList:DLName := "Distribution List"
      oList:Display( .F. )
   ELSE
      ? "Error. MS Outlook not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_MSOutlook2()

   LOCAL oOL, oLista, oMail
   LOCAL i

   IF ( oOL := win_oleCreateObject( "Outlook.Application" ) ) != NIL

      oMail := oOL:CreateItem( 0 /* olMailItem */ )

      FOR i := 1 TO 10
         oMail:Recipients:Add( "Contact" + hb_ntos( i ) + ;
            "<contact" + hb_ntos( i ) + "@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 )
   ELSE
      ? "Error. MS Outlook not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_IExplorer()

   LOCAL oIE

   IF ( oIE := win_oleCreateObject( "InternetExplorer.Application" ) ) != NIL
      oIE:Visible := .T.
      oIE:Navigate( "http://harbour-project.org" )
   ELSE
      ? "Error. IExplorer not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_IExplorer2()

   LOCAL oIE

   IF ( oIE := win_oleCreateObject( "InternetExplorer.Application" ) ) != NIL
      oIE:__hSink := __axRegisterHandler( oIE:__hObj, {| ... | QOut( ... ) } )
      oIE:Visible := .T.
      oIE:Navigate( "http://harbour-project.org" )
      WHILE oIE:ReadyState != 4
         hb_idleSleep( 0 )
      ENDDO
   ELSE
      ? "Error. IExplorer not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_OOCalc()

   LOCAL oServiceManager, oDesktop, oDoc, oSheet

   IF ( oServiceManager := win_oleCreateObject( "com.sun.star.ServiceManager" ) ) != NIL
      oDesktop := oServiceManager:createInstance( "com.sun.star.frame.Desktop" )
      oDoc := oDesktop:loadComponentFromURL( "private:factory/scalc", "_blank", 0, {} )

      oSheet := oDoc:getSheets:getByIndex( 0 )

      oSheet:getCellRangeByName( "A1" ):setString( "OLE from Harbour" )

      oSheet:getCellRangeByName( "A3" ):setString( "String:" )
      oSheet:getCellRangeByName( "B3" ):setString( "Hello, World!" )

      oSheet:getCellRangeByName( "A4" ):setString( "Numeric:" )
      oSheet:getCellRangeByName( "B4" ):setValue( 1234.56 )

      oSheet:getCellRangeByName( "A5" ):setString( "Logical:" )
      oSheet:getCellRangeByName( "B5" ):setValue( .T. )
      oSheet:getCellRangeByName( "B5" ):setPropertyValue( "NumberFormat", 99 ) // BOOLEAN

      oSheet:getCellRangeByName( "A6" ):setString( "Date:" )
      oSheet:getCellRangeByName( "B6" ):setValue( Date() )
      oSheet:getCellRangeByName( "B6" ):setPropertyValue( "NumberFormat", 36 ) // YYYY-MM-DD

      oSheet:getCellRangeByName( "A7" ):setString( "Timestamp:" )
      oSheet:getCellRangeByName( "B7" ):setValue( hb_DateTime() )
      oSheet:getCellRangeByName( "B7" ):setPropertyValue( "NumberFormat", 51 ) // YYYY-MM-DD HH:MM:SS

      oSheet:getCellRangeByName( "A3" ):setPropertyValue( "IsCellBackgroundTransparent", .F. )
      oSheet:getCellRangeByName( "A3" ):setPropertyValue( "CellBackColor", 255 ) // blue
      oSheet:getCellRangeByName( "B3" ):setPropertyValue( "CharColor", 255 * 256 * 256 ) // red
   ELSE
      ? "Error. OpenOffice not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_OOWriter()

   LOCAL oServiceManager, oDesktop, oDoc, oText, oCursor, oTable, oRow, oCell, oRows

   IF ( oServiceManager := win_oleCreateObject( "com.sun.star.ServiceManager" ) ) != NIL
      oDesktop := oServiceManager:createInstance( "com.sun.star.frame.Desktop" )
      oDoc := oDesktop:loadComponentFromURL( "private:factory/swriter", "_blank", 0, {} )

      oText := oDoc:getText
      oCursor := oText:createTextCursor

      oText:insertString( oCursor, "OpenOffice Writer scripting from Harbour." + Chr( 10 ), .F. )

      oText:insertString( oCursor, "This is the second line" + Chr( 10 ), .F. )

      oTable := oDoc:createInstance( "com.sun.star.text.TextTable" )
      oTable:initialize( 2, 4 )

      oText:insertTextContent( oCursor, oTable, .F. )

      oTable:setPropertyValue( "BackTransparent", .F. )
      oTable:setPropertyValue( "BackColor", ( 255 * 256 + 255 ) * 256 + 192 )

      oRows := oTable:getRows
      oRow := oRows:getByIndex( 0 )
      oRow:setPropertyValue( "BackTransparent", .F. )
      oRow:setPropertyValue( "BackColor", ( 192 * 256 + 192 ) * 256 + 128 )

      oCell := oTable:getCellByName( "A1" )
      oCell:insertString( oCell:createTextCursor, "Jan", .F. )
      oCell := oTable:getCellByName( "B1" )
      oCell:insertString( oCell:createTextCursor, "Feb", .F. )
      oCell := oTable:getCellByName( "C1" )
      oCell:insertString( oCell:createTextCursor, "Mar", .F. )

      // I guess we can set text without cursor creation
      oTable:getCellByName( "D1" ):setString( "SUM" )

      oTable:getCellByName( "A2" ):setValue( 123.12 )
      oTable:getCellByName( "B2" ):setValue( 97.07 )
      oTable:getCellByName( "C2" ):setValue( 106.38 )
      oTable:getCellByName( "D2" ):setFormula( "sum <A2:C2>" )

      oText:insertControlCharacter( oCursor, 0, .F. )  // PARAGRAPH_BREAK

      oCursor:setPropertyValue( "CharColor", 255 )
      oText:insertString( oCursor, "Good bye!", .F. )
   ELSE
      ? "Error. OpenOffice not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_OOOpen()

   LOCAL oOO_ServiceManager
   LOCAL oOO_Desktop
   LOCAL oOO_PropVal01
   LOCAL oOO_Doc

   LOCAL cDir

   IF ( oOO_ServiceManager := win_oleCreateObject( "com.sun.star.ServiceManager" ) ) != NIL

      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 } )

      ? "Press any key to close OpenOffice"
      Inkey( 0 )

      oOO_Doc:Close( .T. )
      oOO_Doc := NIL

      oOO_Desktop:Terminate()
      oOO_Desktop := NIL
      oOO_PropVal01 := NIL
   ELSE
      ? "Error: OpenOffice not available.", win_oleErrorText()
   ENDIF

   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

STATIC PROCEDURE Exm_CDO()

   LOCAL oCDOMsg
   LOCAL oCDOConf

   IF ( oCDOMsg := win_oleCreateObject( "CDO.Message" ) ) != NIL

      oCDOConf := win_oleCreateObject( "CDO.Configuration" )

      oCDOConf:Fields( "http://schemas.microsoft.com/cdo/configuration/sendusing" ):Value := 2 // ; cdoSendUsingPort
      oCDOConf:Fields( "http://schemas.microsoft.com/cdo/configuration/smtpserver" ):Value := "localhost"
      oCDOConf:Fields( "http://schemas.microsoft.com/cdo/configuration/smtpserverport" ):Value := 25
      oCDOConf:Fields( "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout" ):Value := 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
         ? "Error: CDO send error.", win_oleErrorText()
      END SEQUENCE
   ELSE
      ? "Error: CDO subsystem not available (needs Windows XP or upper).", win_oleErrorText()
   ENDIF

   RETURN

#define adOpenForwardOnly      0
#define adOpenKeyset           1
#define adOpenDynamic          2
#define adOpenStatic           3

#define adLockReadOnly         1
#define adLockPessimistic      2
#define adLockOptimistic       3
#define adLockBatchOptimistic  4

#define adUseNone              1
#define adUseServer            2
#define adUseClient            3

STATIC PROCEDURE Exm_ADODB()

   LOCAL oRs

   IF ( oRs := win_oleCreateObject( "ADODB.Recordset" ) ) != NIL

      oRs:Open( "SELECT * FROM test ORDER BY First", ;
         "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + hb_DirBase() + "\..\..\hbodbc\tests\test.mdb", ;
         adOpenForwardOnly, ;
         adLockReadOnly )

      DO WHILE ! oRs:EOF
         ? oRs:Fields( "First" ):Value
         oRs:MoveNext()
      ENDDO

      oRs:Close()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_SOAP()

   LOCAL oSoapClient

   IF ! Empty( oSoapClient := win_oleCreateObject( "MSSOAP.SoapClient30" ) )

      oSoapClient:msSoapInit( "http://www.dataaccess.com/webservicesserver/textcasing.wso?WSDL" )

      ? oSoapClient:InvertStringCase( "lower UPPER" )
   ELSE
      ? "Error: SOAP Toolkit 3.0 not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_PocketSOAP()

   LOCAL oHttp := win_oleCreateObject( "PocketSOAP.HTTPTransport.2" )
   LOCAL oEnvelope := win_oleCreateObject( "PocketSOAP.Envelope.2" )

   IF ! Empty( oHttp ) .OR. ! Empty( oEnvelope )

      oEnvelope:EncodingStyle := ""
      oEnvelope:SetMethod( "InvertStringCase", "http://www.dataaccess.com/webservicesserver/" )
      oEnvelope:Parameters:Create( "sAString", "lower UPPER" )
      oHttp:Send( "http://www.dataaccess.com/webservicesserver/textcasing.wso?WSDL", oEnvelope:Serialize() )
      oEnvelope:Parse( oHttp )

      ? oEnvelope:Parameters:Item( 0 ):Value
   ELSE
      ? "Error: PocketSOAP not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_CreateShortcut()

   LOCAL oShell, oSC

   IF ( oShell := win_oleCreateObject( "WScript.Shell" ) ) != NIL
      oSC := oShell:CreateShortcut( hb_DirBase() + hb_ps() + "testole.lnk" )
      oSC:TargetPath := hb_ProgName()
      oSC:WorkingDirectory := hb_DirBase()
      oSC:IconLocation := hb_ProgName() + ",0"
      oSC:Save()
   ELSE
      ? "Error: Shell not available. [" + win_oleErrorText() + "]"
   ENDIF

   RETURN

Linguagemclipper · Mensagem por **Linguagemclipper** » 11 Jul 2022 14:12

Pablo César escreveu:

bencz escreveu:Tem um exemplo na contrib do harbour bem legal, que mostra como trabalhar com os 2 casos:

https://github.com/harbour/core/blob/ma ... ts/ole.prg

Eu não consegui acessar ao clicar, mas obtive pelo cache e assim disponibilizo aqui pra quem interessar:

Código: Selecionar todos

/*
 * Harbour Project source code
 *
 * hbole library demo/test code
 *
 * Copyright 2007 Enrico Maria Giordano e.m.giordano at emagsoftware.it
 * Copyright 2009 Mindaugas Kavaliauskas <dbtopas at dbtopas.lt>
 * Copyright 2008 Viktor Szakats (vszakats.net/harbour)
 *    Exm_CDO(), Exm_OOOpen(), Exm_CreateShortcut()
 *
 * www - http://harbour-project.org
 *
 */

#require "hbwin"

PROCEDURE Main()

   LOCAL nOption

   CLS

   DO WHILE .T.
      ? ""
      ? "Select OLE test:"
      ? "1) MS Excel"
      ? "2) MS Word"
      ? "3) MS Outlook (1)"
      ? "4) MS Outlook (2)"
      ? "5) Internet Explorer"
      ? "6) OpenOffice Calc"
      ? "7) OpenOffice Writer"
      ? "8) OpenOffice Open"
      ? "9) Send mail via CDO"
      ? "a) Read ADODB table"
      ? "b) SOAP Toolkit client"
      ? "c) PocketSOAP client"
      ? "d) Internet Explorer with callback"
      ? "e) Create shortcut"
      ? "0) Quit"
      ? "> "

      nOption := Inkey( 0 )
      ?? hb_keyChar( nOption )

      IF     nOption == hb_keyCode( "1" )
         Exm_MSExcel()
      ELSEIF nOption == hb_keyCode( "2" )
         Exm_MSWord()
      ELSEIF nOption == hb_keyCode( "3" )
         Exm_MSOutlook()
      ELSEIF nOption == hb_keyCode( "4" )
         Exm_MSOutlook2()
      ELSEIF nOption == hb_keyCode( "5" )
         Exm_IExplorer()
      ELSEIF nOption == hb_keyCode( "6" )
         Exm_OOCalc()
      ELSEIF nOption == hb_keyCode( "7" )
         Exm_OOWriter()
      ELSEIF nOption == hb_keyCode( "8" )
         Exm_OOOpen()
      ELSEIF nOption == hb_keyCode( "9" )
         Exm_CDO()
      ELSEIF nOption == hb_keyCode( "a" )
         Exm_ADODB()
      ELSEIF nOption == hb_keyCode( "b" )
         Exm_SOAP()
      ELSEIF nOption == hb_keyCode( "c" )
         Exm_PocketSOAP()
      ELSEIF nOption == hb_keyCode( "d" )
         Exm_IExplorer2()
      ELSEIF nOption == hb_keyCode( "e" )
         Exm_CreateShortcut()
      ELSEIF nOption == hb_keyCode( "0" )
         EXIT
      ENDIF
   ENDDO

   RETURN

STATIC PROCEDURE Exm_MSExcel()

   LOCAL oExcel, oWorkBook, oWorkSheet, oAS
   LOCAL nI, nCount

   IF ( oExcel := win_oleCreateObject( "Excel.Application" ) ) != NIL

      oWorkBook := oExcel:WorkBooks:Add()

      // Enumerator test
      FOR EACH oWorkSheet IN oWorkBook:WorkSheets
         ? oWorkSheet:Name
      NEXT

      // oWorkBook:WorkSheets is a collection
      nCount := oWorkBook:WorkSheets:Count()

      // Elements of collection can be accessed using :Item() method
      FOR nI := 1 TO nCount
         ? oWorkBook:WorkSheets:Item( nI ):Name
      NEXT

      // OLE also allows to access collection elements by passing
      // indices to :Worksheets property
      FOR nI := 1 TO nCount
         ? oWorkBook:WorkSheets( nI ):Name
      NEXT

      oAS := oExcel:ActiveSheet()

      // Set font for all cells
      oAS:Cells:Font:Name := "Arial"
      oAS:Cells:Font:Size := 12

      oAS:Cells( 1, 1 ):Value := "OLE from Harbour"
      oAS:Cells( 1, 1 ):Font:Size := 16

      // oAS:Cells( 1, 1 ) is object, but oAS:Cells( 1, 1 ):Value has value of the cell
      ? "Object valtype:", ValType( oAS:Cells( 1, 1 ) ), "Value:", oAS:Cells( 1, 1 ):Value

      oAS:Cells( 3, 1 ):Value := "String:"
      oAS:Cells( 3, 2 ):Value := "Hello, World!"

      oAS:Cells( 4, 1 ):Value := "Numeric:"
      oAS:Cells( 4, 2 ):Value := 1234.56
      oAS:Cells( 4, 3 ):Value := oAS:Cells( 4, 2 ):Value
      oAS:Cells( 4, 4 ):Value := oAS:Cells( 4, 2 ):Value
      oAS:Cells( 4, 3 ):Value *= 2
      oAS:Cells( 4, 2 ):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:Cells( 7, 1 ):Value := "Timestamp:"
      oAS:Cells( 7, 2 ):Value := hb_DateTime()

      // Some formatting
      oAS:Columns( 1 ):Font:Bold := .T.
      oAS:Columns( 2 ):HorizontalAlignment := - 4152  // xlRight

      oAS:Columns( 1 ):AutoFit()
      oAS:Columns( 2 ):AutoFit()
      oAS:Columns( 3 ):AutoFit()
      oAS:Columns( 4 ):AutoFit()

      oAS:Cells( 3, 2 ):Font:ColorIndex := 3  // red

      oAS:Range( "A1:B1" ):HorizontalAlignment := 7
      oAS:Range( "A3:A7" ):Select()

      oExcel:Visible := .T.

      oExcel:Quit()
   ELSE
      ? "Error: MS Excel not available. [" + win_oleErrorText() + "]"
   ENDIF

   RETURN

STATIC PROCEDURE Exm_MSWord()

   LOCAL oWord, oText

   IF ( oWord := win_oleCreateObject( "Word.Application" ) ) != NIL

      oWord:Documents:Add()

      oText := oWord:Selection()

      oText:Text := "OLE from Harbour" + hb_eol()
      oText:Font:Name := "Arial"
      oText:Font:Size := 48
      oText:Font:Bold := .T.

      oWord:Visible := .T.
      oWord:WindowState := 1 /* Maximize */
   ELSE
      ? "Error. MS Word not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_MSOutlook()

   LOCAL oOL, oList

   IF ( oOL := win_oleCreateObject( "Outlook.Application" ) ) != NIL
      oList := oOL:CreateItem( 7 /* olDistributionListItem */ )
      oList:DLName := "Distribution List"
      oList:Display( .F. )
   ELSE
      ? "Error. MS Outlook not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_MSOutlook2()

   LOCAL oOL, oLista, oMail
   LOCAL i

   IF ( oOL := win_oleCreateObject( "Outlook.Application" ) ) != NIL

      oMail := oOL:CreateItem( 0 /* olMailItem */ )

      FOR i := 1 TO 10
         oMail:Recipients:Add( "Contact" + hb_ntos( i ) + ;
            "<contact" + hb_ntos( i ) + "@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 )
   ELSE
      ? "Error. MS Outlook not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_IExplorer()

   LOCAL oIE

   IF ( oIE := win_oleCreateObject( "InternetExplorer.Application" ) ) != NIL
      oIE:Visible := .T.
      oIE:Navigate( "http://harbour-project.org" )
   ELSE
      ? "Error. IExplorer not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_IExplorer2()

   LOCAL oIE

   IF ( oIE := win_oleCreateObject( "InternetExplorer.Application" ) ) != NIL
      oIE:__hSink := __axRegisterHandler( oIE:__hObj, {| ... | QOut( ... ) } )
      oIE:Visible := .T.
      oIE:Navigate( "http://harbour-project.org" )
      WHILE oIE:ReadyState != 4
         hb_idleSleep( 0 )
      ENDDO
   ELSE
      ? "Error. IExplorer not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_OOCalc()

   LOCAL oServiceManager, oDesktop, oDoc, oSheet

   IF ( oServiceManager := win_oleCreateObject( "com.sun.star.ServiceManager" ) ) != NIL
      oDesktop := oServiceManager:createInstance( "com.sun.star.frame.Desktop" )
      oDoc := oDesktop:loadComponentFromURL( "private:factory/scalc", "_blank", 0, {} )

      oSheet := oDoc:getSheets:getByIndex( 0 )

      oSheet:getCellRangeByName( "A1" ):setString( "OLE from Harbour" )

      oSheet:getCellRangeByName( "A3" ):setString( "String:" )
      oSheet:getCellRangeByName( "B3" ):setString( "Hello, World!" )

      oSheet:getCellRangeByName( "A4" ):setString( "Numeric:" )
      oSheet:getCellRangeByName( "B4" ):setValue( 1234.56 )

      oSheet:getCellRangeByName( "A5" ):setString( "Logical:" )
      oSheet:getCellRangeByName( "B5" ):setValue( .T. )
      oSheet:getCellRangeByName( "B5" ):setPropertyValue( "NumberFormat", 99 ) // BOOLEAN

      oSheet:getCellRangeByName( "A6" ):setString( "Date:" )
      oSheet:getCellRangeByName( "B6" ):setValue( Date() )
      oSheet:getCellRangeByName( "B6" ):setPropertyValue( "NumberFormat", 36 ) // YYYY-MM-DD

      oSheet:getCellRangeByName( "A7" ):setString( "Timestamp:" )
      oSheet:getCellRangeByName( "B7" ):setValue( hb_DateTime() )
      oSheet:getCellRangeByName( "B7" ):setPropertyValue( "NumberFormat", 51 ) // YYYY-MM-DD HH:MM:SS

      oSheet:getCellRangeByName( "A3" ):setPropertyValue( "IsCellBackgroundTransparent", .F. )
      oSheet:getCellRangeByName( "A3" ):setPropertyValue( "CellBackColor", 255 ) // blue
      oSheet:getCellRangeByName( "B3" ):setPropertyValue( "CharColor", 255 * 256 * 256 ) // red
   ELSE
      ? "Error. OpenOffice not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_OOWriter()

   LOCAL oServiceManager, oDesktop, oDoc, oText, oCursor, oTable, oRow, oCell, oRows

   IF ( oServiceManager := win_oleCreateObject( "com.sun.star.ServiceManager" ) ) != NIL
      oDesktop := oServiceManager:createInstance( "com.sun.star.frame.Desktop" )
      oDoc := oDesktop:loadComponentFromURL( "private:factory/swriter", "_blank", 0, {} )

      oText := oDoc:getText
      oCursor := oText:createTextCursor

      oText:insertString( oCursor, "OpenOffice Writer scripting from Harbour." + Chr( 10 ), .F. )

      oText:insertString( oCursor, "This is the second line" + Chr( 10 ), .F. )

      oTable := oDoc:createInstance( "com.sun.star.text.TextTable" )
      oTable:initialize( 2, 4 )

      oText:insertTextContent( oCursor, oTable, .F. )

      oTable:setPropertyValue( "BackTransparent", .F. )
      oTable:setPropertyValue( "BackColor", ( 255 * 256 + 255 ) * 256 + 192 )

      oRows := oTable:getRows
      oRow := oRows:getByIndex( 0 )
      oRow:setPropertyValue( "BackTransparent", .F. )
      oRow:setPropertyValue( "BackColor", ( 192 * 256 + 192 ) * 256 + 128 )

      oCell := oTable:getCellByName( "A1" )
      oCell:insertString( oCell:createTextCursor, "Jan", .F. )
      oCell := oTable:getCellByName( "B1" )
      oCell:insertString( oCell:createTextCursor, "Feb", .F. )
      oCell := oTable:getCellByName( "C1" )
      oCell:insertString( oCell:createTextCursor, "Mar", .F. )

      // I guess we can set text without cursor creation
      oTable:getCellByName( "D1" ):setString( "SUM" )

      oTable:getCellByName( "A2" ):setValue( 123.12 )
      oTable:getCellByName( "B2" ):setValue( 97.07 )
      oTable:getCellByName( "C2" ):setValue( 106.38 )
      oTable:getCellByName( "D2" ):setFormula( "sum <A2:C2>" )

      oText:insertControlCharacter( oCursor, 0, .F. )  // PARAGRAPH_BREAK

      oCursor:setPropertyValue( "CharColor", 255 )
      oText:insertString( oCursor, "Good bye!", .F. )
   ELSE
      ? "Error. OpenOffice not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_OOOpen()

   LOCAL oOO_ServiceManager
   LOCAL oOO_Desktop
   LOCAL oOO_PropVal01
   LOCAL oOO_Doc

   LOCAL cDir

   IF ( oOO_ServiceManager := win_oleCreateObject( "com.sun.star.ServiceManager" ) ) != NIL

      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 } )

      ? "Press any key to close OpenOffice"
      Inkey( 0 )

      oOO_Doc:Close( .T. )
      oOO_Doc := NIL

      oOO_Desktop:Terminate()
      oOO_Desktop := NIL
      oOO_PropVal01 := NIL
   ELSE
      ? "Error: OpenOffice not available.", win_oleErrorText()
   ENDIF

   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

STATIC PROCEDURE Exm_CDO()

   LOCAL oCDOMsg
   LOCAL oCDOConf

   IF ( oCDOMsg := win_oleCreateObject( "CDO.Message" ) ) != NIL

      oCDOConf := win_oleCreateObject( "CDO.Configuration" )

      oCDOConf:Fields( "http://schemas.microsoft.com/cdo/configuration/sendusing" ):Value := 2 // ; cdoSendUsingPort
      oCDOConf:Fields( "http://schemas.microsoft.com/cdo/configuration/smtpserver" ):Value := "localhost"
      oCDOConf:Fields( "http://schemas.microsoft.com/cdo/configuration/smtpserverport" ):Value := 25
      oCDOConf:Fields( "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout" ):Value := 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
         ? "Error: CDO send error.", win_oleErrorText()
      END SEQUENCE
   ELSE
      ? "Error: CDO subsystem not available (needs Windows XP or upper).", win_oleErrorText()
   ENDIF

   RETURN

#define adOpenForwardOnly      0
#define adOpenKeyset           1
#define adOpenDynamic          2
#define adOpenStatic           3

#define adLockReadOnly         1
#define adLockPessimistic      2
#define adLockOptimistic       3
#define adLockBatchOptimistic  4

#define adUseNone              1
#define adUseServer            2
#define adUseClient            3

STATIC PROCEDURE Exm_ADODB()

   LOCAL oRs

   IF ( oRs := win_oleCreateObject( "ADODB.Recordset" ) ) != NIL

      oRs:Open( "SELECT * FROM test ORDER BY First", ;
         "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + hb_DirBase() + "\..\..\hbodbc\tests\test.mdb", ;
         adOpenForwardOnly, ;
         adLockReadOnly )

      DO WHILE ! oRs:EOF
         ? oRs:Fields( "First" ):Value
         oRs:MoveNext()
      ENDDO

      oRs:Close()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_SOAP()

   LOCAL oSoapClient

   IF ! Empty( oSoapClient := win_oleCreateObject( "MSSOAP.SoapClient30" ) )

      oSoapClient:msSoapInit( "http://www.dataaccess.com/webservicesserver/textcasing.wso?WSDL" )

      ? oSoapClient:InvertStringCase( "lower UPPER" )
   ELSE
      ? "Error: SOAP Toolkit 3.0 not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_PocketSOAP()

   LOCAL oHttp := win_oleCreateObject( "PocketSOAP.HTTPTransport.2" )
   LOCAL oEnvelope := win_oleCreateObject( "PocketSOAP.Envelope.2" )

   IF ! Empty( oHttp ) .OR. ! Empty( oEnvelope )

      oEnvelope:EncodingStyle := ""
      oEnvelope:SetMethod( "InvertStringCase", "http://www.dataaccess.com/webservicesserver/" )
      oEnvelope:Parameters:Create( "sAString", "lower UPPER" )
      oHttp:Send( "http://www.dataaccess.com/webservicesserver/textcasing.wso?WSDL", oEnvelope:Serialize() )
      oEnvelope:Parse( oHttp )

      ? oEnvelope:Parameters:Item( 0 ):Value
   ELSE
      ? "Error: PocketSOAP not available.", win_oleErrorText()
   ENDIF

   RETURN

STATIC PROCEDURE Exm_CreateShortcut()

   LOCAL oShell, oSC

   IF ( oShell := win_oleCreateObject( "WScript.Shell" ) ) != NIL
      oSC := oShell:CreateShortcut( hb_DirBase() + hb_ps() + "testole.lnk" )
      oSC:TargetPath := hb_ProgName()
      oSC:WorkingDirectory := hb_DirBase()
      oSC:IconLocation := hb_ProgName() + ",0"
      oSC:Save()
   ELSE
      ? "Error: Shell not available. [" + win_oleErrorText() + "]"
   ENDIF

   RETURN

Minha gente, como será possível trabalhar assim?

Código: Selecionar todos

oSheet:getCellRangeByName( "A1" ):setString( "OLE from Harbour" )

As linhas são letras? Como é que eu vou gerar um relatório assim? Como vou gerar linha a linha?
Outra coisa, como vou saber colocar borda, negrito, sublinhado, alinhamento horizontal e vertical, imagem, definir células de cabeçalho (que se repetirão em cada página) etc? Onde acho informações a respeito?

Mensagem por **JoséQuintas** » 11 Jul 2022 15:20

OLE é usar um programa através de rotinas do outro.
Pra encontrar informações de Excel, é procurando sobre automação do Excel.

Sinceramente.... eu acho tudo isso perda de tempo.
O Excel, até onde sei, permite programaçào, e ler diretamente qualquer base de dados.

Ou faz o que precisa no Excel, ou acessa usando ADO, que dá acesso as planilhas como se fosse uma base de dados.

Parece tudo até uma grande piada.

Fugir da Microsoft pra..... usar Microsoft....
Não usar Excel pra.... usar Excel....

Em todo caso:

https://docs.microsoft.com/pt-br/office ... on(object)

Aproveitando:

VBScript - Visual Basic pra usar no Windows ou internet
VBA - Visual Basic pra usar no Office - FAZ PARTE do Office, não é separado
Visual Basic - pra aplicativo
ASP - permite Visual Basic
Visual Basic pode tudo no Windows, não precisa nem compilar.

carlaoonline · Mensagem por **carlaoonline** » 11 Jul 2022 15:46

Boa tarde!

JoséQuintas escreveu:Ou faz o que precisa no Excel, ou acessa usando ADO, que dá acesso as planilhas como se fosse uma base de dados.

O problema são os usuários: Adoram uma planilha, um controle paralelo, tipo um re-trabalho....

Eles tem o sistema (feito em Harbour OU QQUER LINGUAGEM ULTRA MODERNA) que lhes dão todos os tipos de listagens , métricas, Dashboards e afins, e caso o sistema não forneça ainda, é só solicitar ao setor de desenvolvimento...... porém sempre dão um jeitinho de copiar e colar, de exportar para o raio da "Planilha do Excel"...

Então não tem jeito, muitas vezes tem que incorporar...

Eu não tenho nada programado para "Ler" uma planilha, mas para gerar arquivo XLSX eu uso o hblibxlsxwriter
https://github.com/FTrautwein/hblibxlsxwriter

É possível gerar planilha XLSX sem a necessidade de ter o Excel instalado na máquina, ele gera o arquivo independente, e pode ser aberto pelo Excel, pelo LibreOffice ou qualquer alternativa ao Office.

Gero planilhas com fórmulas, gráficos e até com macros. Algumas coisas são mais fáceis e outras mais chatas.