Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations TouchToneTommy on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Using COM to access Excel through Fujitsu COBOL (inc. POWER COBOL)

Cobol Code Examples

Using COM to access Excel through Fujitsu COBOL (inc. POWER COBOL)

by  fredericofonseca  Posted    (Edited  )
The code below opens Excel on a separate process. It is not an embedded control.

It can be used from both NetCOBOL and POWERCOBOL.
For an initial test it is better if debugger is used to step through the code. Alternativelly place an accept before the "INVOKE OBJ-WBK "Close"." so that a result can be seen


Code:
 add to repository
           CLASS COM-EXCEPTION AS "*COM-EXCEPTION"
           CLASS COM AS "*COM".

Code:
 add to scriplets
       WORKING-STORAGE SECTION.
       01 GLOBAL-WS.
           05  XLS-APP-TYPE   PIC X(8192) VALUE "Excel.Application".  
           05  OBJ-APP  OBJECT REFERENCE COM.
           05  OBJ-WBKS   OBJECT REFERENCE COM.
           05  OBJ-WKS   OBJECT REFERENCE COM.
           05  OBJ-WKSS   OBJECT REFERENCE COM.
           05  OBJ-WBK   OBJECT REFERENCE COM.
           05  OBJ-RANGE   OBJECT REFERENCE COM.
           05  RETURN-ERROR   PIC 9(9) COMP-5.
           05  WINDEX PIC S9(9) COMP-5 VALUE 1.
       01 W-WORKBOOK PIC X(40) VALUE "mypathname\myexcelfile.xls".
       01 W-TRUE PIC S9(4) COMP-5 VALUE -1.
       01 M1 PIC X(2) VALUE "A ".
       01 M1-R REDEFINES M1.
          05 PIC X.
          05 N1 PIC 9.
       01 W-VALUE1 PIC X(10).
       PROCEDURE       DIVISION.
           INVOKE COM "CREATE-OBJECT" 
                  USING XLS-APP-TYPE
                  RETURNING OBJ-APP.
           INVOKE OBJ-APP "GET-WORKBOOKS"
           RETURNING OBJ-WBKS.
           INVOKE OBJ-WBKS "OPEN"
                  USING W-WORKBOOK
              RETURNING OBJ-WBK
           INVOKE OBJ-WBK "GET-WORKSHEETS"
                  RETURNING OBJ-WKSS
           INVOKE OBJ-WKSS "GET-ITEM"
                  USING WINDEX
                  RETURNING OBJ-WKS
           INVOKE OBJ-WKS "ACTIVATE"
           INVOKE OBJ-APP "SET-Visible"
                  USING W-TRUE 
                  RETURNING RETURN-ERROR.
           MOVE 1 TO TO WINDEX
           INVOKE OBJ-WKSS "GET-ITEM"
                  USING WINDEX
                  RETURNING OBJ-WKS
           INVOKE OBJ-WKS "ACTIVATE"
           INVOKE OBJ-WKS "GET-RANGE"
                  RETURNING
                  OBJ-RANGE
           PERFORM VARYING N1 FROM 1 BY 1 UNTIL N1 = 9
               DISPLAY "M1=" M1
               INVOKE OBJ-WKS "GET-RANGE"
                      USING M1
                      RETURNING
                      OBJ-RANGE
               INVOKE OBJ-RANGE "GET-VALUE"
                      RETURNING W-VALUE1
               DISPLAY "M1=" M1 " VAL=" W-VALUE1 "="
           END-PERFORM
           
           INVOKE OBJ-WBK "Close".
           INVOKE OBJ-APP "Quit".
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top