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