ExcelReadServiceの例

* Uses Integrator Services: EXCELREADSERVICE

 
* This function reads an EXCEL file into a list
* or writes information to an EXCEL file from a list

* Beginning of RDML commands **********
FUNCTION OPTIONS(*DIRECT)

DEFINE FIELD(#JSMSTS) TYPE(*CHAR) LENGTH(020)
DEFINE FIELD(#JSMCMD) TYPE(*CHAR) LENGTH(255)
DEFINE FIELD(#JSMMSG) TYPE(*CHAR) LENGTH(255)

DEFINE FIELD(#EXCELFIL) TYPE(*CHAR) LENGTH(79) LABEL('File path:') COLHDG('EXCEL File to open')
DEFINE FIELD(#EXCELSHT) TYPE(*CHAR) LENGTH(25) LABEL('Worksheet:') COLHDG('EXCEL Worksheet') DEFAULT('sheet1')
DEFINE FIELD(#LINENUM) TYPE(*DEC) LENGTH(7) DECIMALS(0) COLHDG('Line') EDIT_CODE(3)
DEFINE FIELD(#PARTNUM) TYPE(*CHAR) LENGTH(7) COLHDG('Part')
DEFINE FIELD(#PARTDSC) REFFLD(#STD_DESC)
DEFINE FIELD(#PARTAMT) TYPE(*DEC) LENGTH(9) DECIMALS(2) COLHDG('Unit Price') EDIT_CODE(3)
DEFINE FIELD(#PARTQTY) TYPE(*DEC) LENGTH(7) DECIMALS(0) COLHDG('Quantity') EDIT_CODE(3)

DEF_LIST NAME(#ORDLIST) FIELDS(#LINENUM #PARTNUM #PARTDSC #PARTAMT #PARTQTY) COUNTER(#LISTCOUNT)
DEF_LIST NAME(#ORDLISTW) FIELDS(#LINENUM #PARTNUM #PARTDSC #PARTAMT #PARTQTY) TYPE(*WORKING)

* Open service
USE BUILTIN(JSM_OPEN) TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)

* Load service
USE BUILTIN(JSM_COMMAND) WITH_ARGS('SERVICE_LOAD SERVICE(EXCELREADSERVICE)') TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)

MESSAGE MSGTXT('ExcelReadService loaded')

EXECUTE SUBROUTINE(CLEARLST)

BEGIN_LOOP

* request name of folder to be zipped and target zip file
CHANGE FIELD(#STD_INSTR) TO('''Type the EXCEL file name to be read or written.  Use buttons to process.''')

REQUEST FIELDS((#STD_INSTR *L003 *P002 *OUTPUT *NOID) (#EXCELFIL *L004 *P002) (#EXCELSHT *L006 *P002 *COLHDG)) DESIGN(*DOWN) IDENTIFY(*COLHDG) DOWN_SEP(001) ACROSS_SEP(001) BROWSELIST(#ORDLIST) EXIT_KEY(*NO) MENU_KEY(*YES *NEXT) PROMPT_KEY(*NO) USER_KEYS((05 'Read' *NEXT *NONE)(06 'Write' *NEXT *NONE)(07 'Clear'))

IF_KEY WAS(*MENU)
* Close service
EXECUTE SUBROUTINE(DISCONNECT)
MENU
ENDIF

* read the EXCEL file
IF_KEY WAS(*USERKEY1)
EXECUTE SUBROUTINE(READEXCEL)
ENDIF

* write to the EXCEL file
IF_KEY WAS(*USERKEY2)
EXECUTE SUBROUTINE(WRITEEXCEL)
ENDIF

* clear the list information
IF_KEY WAS(*USERKEY3)
EXECUTE SUBROUTINE(CLEARLST)
ENDIF

END_LOOP

* Read the nominated EXCEL file
* (columns must match the working list definition)
SUBROUTINE NAME(READEXCEL)

CLR_LIST NAMED(#ORDLISTW)
CLR_LIST NAMED(#ORDLIST)

* Open the EXCEL order file
CHANGE FIELD(#JSMCMD) TO(OPEN)
EXECUTE SUBROUTINE(KEYWRD) WITH_PARMS(FILE #EXCELFIL)
USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)

* Read the EXCEL order file
CHANGE FIELD(#JSMCMD) TO('READ SERVICE_LIST(LINENUM,PARTNUM,PARTDSC,PARTAMT,PARTQTY)')
EXECUTE SUBROUTINE(KEYWRD) WITH_PARMS(R1C1 '2,1')
EXECUTE SUBROUTINE(KEYWRD) WITH_PARMS(R2C2 '3,0')
IF COND('#EXCELSHT *NE *BLANK')
EXECUTE SUBROUTINE(KEYWRD) WITH_PARMS(SHEET #EXCELSHT)
ENDIF
USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG #ORDLISTW)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)

SELECTLIST NAMED(#ORDLISTW)
ADD_ENTRY TO_LIST(#ORDLIST) WITH_MODE(*ADD)
ENDSELECT

* add a blank line for new details
CHANGE FIELD(#ORDLIST) TO(*DEFAULT)
CHANGE FIELD(#LINENUM) TO(#LISTCOUNT)

BEGIN_LOOP TO(5)
CHANGE FIELD(#LINENUM) TO('#LINENUM + 1')
ADD_ENTRY TO_LIST(#ORDLIST) WITH_MODE(*ADD)
END_LOOP

EXECUTE SUBROUTINE(CLOSE)

* Confirm file read is complete
MESSAGE MSGTXT('File has been successfully read')

ENDROUTINE

* Write to the nominated EXCEL file
* (columns must match the working list definition)
SUBROUTINE NAME(WRITEEXCEL)

CLR_LIST NAMED(#ORDLISTW)

SELECTLIST NAMED(#ORDLIST)

IF COND('#PARTNUM *NE *BLANK')
ADD_ENTRY TO_LIST(#ORDLISTW)
ENDIF

ENDSELECT

* Open the EXCEL order file
CHANGE FIELD(#JSMCMD) TO('OPEN MODE(*WRITE)')
EXECUTE SUBROUTINE(KEYWRD) WITH_PARMS(FILE #EXCELFIL)
USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)

* Create the specified EXCEL file
CHANGE FIELD(#JSMCMD) TO('WRITE SERVICE_LIST(LINENUM,PARTNUM,PARTDSC,PARTAMT,PARTQTY)')
IF COND('#EXCELSHT *NE *BLANK')
EXECUTE SUBROUTINE(KEYWRD) WITH_PARMS(SHEET #EXCELSHT)
ENDIF
USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG #ORDLISTW)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)

EXECUTE SUBROUTINE(CLOSE)

* Confirm write of file is complete
MESSAGE MSGTXT('Order has been successfully written to file')

ENDROUTINE

* Close all open worksheets
SUBROUTINE NAME(CLOSE)
USE BUILTIN(JSM_COMMAND) WITH_ARGS(CLOSE) TO_GET(#JSMSTS #JSMMSG)
ENDROUTINE

* Clear list
SUBROUTINE NAME(CLEARLST)
CLR_LIST NAMED(#ORDLIST)

BEGIN_LOOP USING(#LINENUM) TO(10)
ADD_ENTRY TO_LIST(#ORDLIST) WITH_MODE(*ADD)
END_LOOP

ENDROUTINE

SUBROUTINE NAME(DISCONNECT)

* Unload service
USE BUILTIN(JSM_COMMAND) WITH_ARGS('SERVICE_UNLOAD') TO_GET(#JSMSTS #JSMMSG)

* Close service
USE BUILTIN(JSM_CLOSE) TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)

ENDROUTINE

* Build JSM commands
SUBROUTINE NAME(KEYWRD) PARMS((#KEYWORD *RECEIVED) (#KEYW_VAL1 *RECEIVED))
DEFINE FIELD(#KEYWORD) REFFLD(#STD_TEXT)
DEFINE FIELD(#KEYW_VAL1) REFFLD(#STD_TEXTL)

USE BUILTIN(BCONCAT) WITH_ARGS(#JSMCMD #KEYWORD) TO_GET(#JSMCMD)
USE BUILTIN(TCONCAT) WITH_ARGS(#JSMCMD '(' #KEYW_VAL1 ')') TO_GET(#JSMCMD)

ENDROUTINE

* Check the JSM return status
SUBROUTINE NAME(CHECK) PARMS((#JSMSTS *RECEIVED) (#JSMMSG *RECEIVED))

IF COND('#JSMSTS *NE OK')
USE BUILTIN(TCONCAT) WITH_ARGS(#JSMSTS ' : ' #JSMMSG) TO_GET(#STD_TEXTL)
MESSAGE MSGID(DCM9899) MSGF(DC@M01) MSGDTA(#STD_TEXTL)
ENDIF

ENDROUTINE