Re: Cobol MS-Access

On Feb 14, 4:51 pm, JC <c.joyd...@xxxxxxxxx> wrote:
Hi,

Is there any tutorial/guide available for accessing MS-Access from
Cobol? Everything is on Windows Vista.
Thanks for your help.

here is an extract of a program I wrote for MicroFocus to create and
load a spreadsheet
and, yes it is ugly
but, yes it works

$set ooctrl(+P)
IDENTIFICATION DIVISION.
PROGRAM-ID. EXCEL01.
AUTHOR. CG.
DATE-WRITTEN. March 2005.

ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
call-convention 66 is WIN32APIDYN.
INPUT-OUTPUT SECTION.
FILE-CONTROL.

CLASS-CONTROL.
MicrosoftExcel is class "$OLE$Excel.Application"
EntryPointCallback is class "entrycll"
ExceptionManager is class "exptnmgr"
AutomationExceptionManager is class "oleexpt"
AutomationSupport is class "olesup".


*****************************************************************
DATA DIVISION.
FILE SECTION.


*****************************************************************
WORKING-STORAGE SECTION.

*****************************************************************
copy "TypeLib.cpy".

01 Excel OBJECT REFERENCE.
01 NullReference OBJECT REFERENCE VALUE
NULL.
01 HandlerObject OBJECT REFERENCE.
01 Workbooks OBJECT REFERENCE.
01 Workbook OBJECT REFERENCE.
01 WorkSheets OBJECT REFERENCE.
01 WorkSheet OBJECT REFERENCE.
01 Cell OBJECT REFERENCE.
01 CellRange OBJECT REFERENCE.
01 FloatValue COMP-1.
01 ErrorOccurred PIC 9 VALUE 0.
01 FileFilter PIC X(46) VALUE
z"Excel Files (*.xls),*.xls,All Files (*.*),*.*".

01 FileName.
05 PIC X(29) VALUE "M:\OE-XLS\TIME_SHEET_SUMMARY_".
05 PIC X(4) VALUE ".xls".

01 Indexes.
05 RowIndex PIC XX COMP-5.
05 ColumnIndex PIC XX COMP-5.

01 STORAGE.
05 WS-CELL-VALUE PIC X(120).
05 WS-CELL-VALUE-LEN PIC 9999.
05 WS-TOTAL-ROW PIC X(4).

01 shrink-in.
05 sin pic x occurs 120.
01 shrink-out.
05 sot pic x occurs 120.
01 shrink-a pic 999.
01 shrink-b pic 999.
01 shrink-LINE-LEN PIC X(4) COMP-5.

LOCAL-STORAGE SECTION.

LINKAGE SECTION.
01 ErrorNumber PIC X(4) COMP-5.
01 ErrorObject OBJECT REFERENCE.
01 ErrorText OBJECT REFERENCE.


******************************************************************
PROCEDURE DIVISION.

******************************************************************
100-START-SECTION SECTION.
100-START-PROGRAM.

PERFORM 8000-CREATE-EXCEL.
PERFORM 8100-LOAD-EXCEL-HEADERS.
PERFORM 8200-LOAD-EXCEL-DETAIL.
PERFORM 8300-LOAD-EXCEL-TOTALS.
PERFORM 8500-LOAD-EXCEL-FOOTERS.
PERFORM 8600-SAVE-EXCEL.
PERFORM 8700-CLOSE-EXCEL.

990-EXIT.
EXIT PROGRAM.
999-EOJ.
STOP RUN.


******************************************************************
8000-Create-Excel.

******************************************************************
* create a new instance of Excel and make visible
INVOKE EntryPointCallback "new" USING
z"AutomationException"
RETURNING HandlerObject

INVOKE ExceptionManager "register"
USING AutomationExceptionManager
HandlerObject

INVOKE MicrosoftExcel "new" RETURNING Excel
* error handling
IF ErrorOccurred = 1
display "Unable to load the Automation Server"
STOP RUN
END-IF

INVOKE Excel "setVisible" USING BY VALUE Automation-True

INVOKE Excel "getWorkBooks" RETURNING WorkBooks

INVOKE Workbooks "Add" RETURNING Workbook

INVOKE Workbook "getWorkSheets" RETURNING WorkSheets

INVOKE WorkSheets "getItem" USING BY VALUE 1
RETURNING WorkSheet.


******************************************************************
8100-Load-Excel-Headers.

******************************************************************
MOVE 1 TO RowIndex
MOVE 1 TO ColumnIndex
MOVE SS-HEAD-2 TO WS-CELL-VALUE
PERFORM 8800-LOAD-CELL

* WEEK 1
ADD 1 TO RowIndex
MOVE 1 TO ColumnIndex
* Regular Hours
MOVE "Regular Hours" TO WS-CELL-VALUE
PERFORM 8800-LOAD-CELL
* Overtime
ADD 1 to ColumnIndex
MOVE "Overtime" TO WS-CELL-VALUE
PERFORM 8800-LOAD-CELL
.


******************************************************************
8200-Load-Excel-Detail.

******************************************************************
ADD 1 TO RowIndex
MOVE 1 TO ColumnIndex
MOVE SS-TOTREG1 TO WS-CELL-VALUE *> week 1 reg hours
PERFORM 8800-LOAD-CELL
ADD 1 TO ColumnIndex
MOVE SS-TOTOVR1 TO WS-CELL-VALUE *> week 1 overtime
PERFORM 8800-LOAD-CELL
.


******************************************************************
8300-Load-Excel-Totals.

******************************************************************
MOVE RowIndex to WS-TOTAL-ROW
ADD 2 TO RowIndex

MOVE 1 TO ColumnIndex
STRING "=SUM(A3:A" WS-TOTAL-ROW ")" INTO WS-CELL-VALUE
PERFORM 8800-LOAD-CELL
ADD 1 TO ColumnIndex
STRING "=SUM(B3:B" WS-TOTAL-ROW ")" INTO WS-CELL-VALUE
PERFORM 8800-LOAD-CELL
.


******************************************************************
8500-Load-Excel-Footers.

******************************************************************
ADD 3 TO RowIndex
MOVE 1 TO ColumnIndex
MOVE SS-BOTT-1 TO WS-CELL-VALUE
PERFORM 8800-LOAD-CELL
ADD 1 TO RowIndex
MOVE SS-BOTT-2 TO WS-CELL-VALU
.


******************************************************************
8600-Save-Excel.

******************************************************************
INVOKE WorkSheet "SaveAs" USING FILENAME
.


******************************************************************
8700-Close-Excel.

******************************************************************
INVOKE Workbook "Close" USING BY VALUE 0
INVOKE WorkSheet "Finalize" RETURNING WorkSheet
INVOKE WorkSheets "Finalize" RETURNING WorkSheets
INVOKE WorkBook "Finalize" RETURNING WorkBook
INVOKE WorkBooks "Finalize" RETURNING WorkBooks
INVOKE Excel "Quit"
INVOKE Excel "Finalize" RETURNING Excel
.


******************************************************************
8800-LOAD-CELL.

******************************************************************
INVOKE Excel "getCells" USING BY VALUE RowIndex
BY VALUE ColumnIndex
RETURNING Cell
MOVE WS-CELL-VALUE TO SHRINK-IN
PERFORM SHRINK-COMMAND THRU SHRINK-COMMAND-EXIT
INVOKE Cell "setValue" USING SHRINK-OUT(1:SHRINK-LINE-LEN)
INVOKE Cell "Finalize" RETURNING Cell
MOVE SPACES TO WS-CELL-VALUE
.


******************************************************************
shrink-command.
* change all multiple spaces to single spaces
* input is shrink-in, output is shrink-out
move space to shrink-out.
move 1 to shrink-a.
move 1 to shrink-b.
shrink-loop1.
move sin (shrink-a) to sot (shrink-b).
add 1 to shrink-a.
add 1 to shrink-b.
if shrink-a > 120 go to shrink-done.
if sin (shrink-a) not = " "
go to shrink-loop1.
add 1 to shrink-b.
shrink-loop2.
add 1 to shrink-a.
if shrink-a > 120 go to shrink-done.
if sin (shrink-a) = " "
go to shrink-loop2.
go to shrink-loop1.
shrink-done.
move shrink-b to shrink-line-len.
shrink-command-exit.
exit.


******************************************************************
CALLBACK SECTION.

******************************************************************
ENTRY "AutomationException"
USING BY REFERENCE ErrorObject
BY REFERENCE ErrorNumber
BY REFERENCE ErrorText.
MOVE 1 TO ErrorOccurred
DISPLAY "ErrorNumber:" ErrorNumber
INVOKE ErrorText "DISPLAY"
EXIT PROGRAM RETURNING NullReference.

.