Copy All Documents
To avoid damaging the original documents in a folder during testing, I always have to manually go to the Work with Documents (WRKDOC) panel, use option 3 to mark all the documents in that folder, then copy them to my test folder. I thought it would be nice to have a copy command in the AS/400 that could be fed a few parameters, such as the folder name that has all the documents that I need, and the folder name where I want them to go. So I wrote my own Copy Folder Documents (CPYFLRDOC) command to do the work for me (see 1).
To avoid damaging the original documents in a folder during testing, I always have to manually go to the Work with Documents (WRKDOC) panel, use option 3 to mark all the documents in that folder, then copy them to my test folder. I thought it would be nice to have a copy command in the AS/400 that could be fed a few parameters, such as the folder name that has all the documents that I need, and the folder name where I want them to go. So I wrote my own Copy Folder Documents (CPYFLRDOC) command to do the work for me (see Figure 1).
CPYFLRDOC requires three parameters: the folder name where all the documents reside, the subfolder and the main folder where you want all the documents to copy to.
The logic of the FLR003CL program (2) is simple. First, check if the folder exists. Next, check if the subfolder destination exists; if not, create it. Using the Query Document Library (QRYDOCLIB) command, retrieve from the QAOS1QDL outfile the name of the document in the target folder. Feed the document name from &QDLDNM to the CPYDOC command which does the actual copying, then loop through the retrieve and copy process until the last document is found.
The logic of the FLR003CL program (Figure 2) is simple. First, check if the folder exists. Next, check if the subfolder destination exists; if not, create it. Using the Query Document Library (QRYDOCLIB) command, retrieve from the QAOS1QDL outfile the name of the document in the target folder. Feed the document name from &QDLDNM to the CPYDOC command which does the actual copying, then loop through the retrieve and copy process until the last document is found.
CPYFLRDOC will replace the document if it exists in the subfolder
TechTalk: Copy All Documents
Figure 1 Command CPYFLRDOC
CPYFLRDOC: CMD PROMPT('Copy Folder Documents') PARM KWD(FLR) TYPE(*CHAR) LEN(63) MIN(1) + EXPR(*YES) PROMPT('From folder') PARM KWD(YOURSUB) TYPE(*CHAR) LEN(63) MIN(1) + EXPR(*YES) PROMPT('Subfolder') PARM KWD(YOURFLR) TYPE(*CHAR) LEN(63) MIN(1) + EXPR(*YES) PROMPT('In folder')
TechTalk: Copy All Documents
Figure 2 CL program FLR003CL
FLR003CL: + PGM PARM(&FLR &YOURSUB &YOURFLR) DCL VAR(&FLR) TYPE(*CHAR) LEN(63) DCL VAR(&YOURFLR) TYPE(*CHAR) LEN(63) DCL VAR(&YOURSUB) TYPE(*CHAR) LEN(63) DCL VAR(&STRFLR) TYPE(*CHAR) LEN(63) DCL VAR(&DOC) TYPE(*CHAR) LEN(12) DCL VAR(&ENDLOOP) TYPE(*LGL) LEN(1) VALUE('0') DCLF FILE(QAOSIQDL) OVRDBF FILE(QAOSIQDL) TOFILE(QTEMP/QAOSIQDL) /* Create subfolder if it does not exist */ CHGVAR VAR(&STRFLR) VALUE(&YOURFLR *TCAT '/' *TCAT &YOURSUB) CHKDLO DLO(&YOURSUB) FLR(&YOURFLR) OBJTYPE(*FLR) MONMSG MSGID(CPF8A77) EXEC(DO) CRTFLR FLR(&YOURSUB) INFLR(&YOURFLR) ENDDO /* Query all information on folder to QTEMP/QAOSIQDL */ QRYDOCLIB FLR(&FLR) OUTFILE(QTEMP/QAOSIQDL) MONMSG MSGID(CPF905D) EXEC(DO) SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('CPF905D: Query + of library documents failed') MSGTYPE(*ESCAPE) RETURN ENDDO CPYLOOP: + RCVF MONMSG MSGID(CPF0864) EXEC(RETURN) /* Assign &QDLDNM from QAOSIQDL physical file to variable &DOC */ SKIPRCVF: + CHGVAR VAR(&DOC) VALUE(&QDLDNM) RCVF MONMSG MSGID(CPF0864) EXEC(DO) CHGVAR VAR(&ENDLOOP) VALUE('1') ENDDO /* Call CPYDOC to copy the document */ CPYDOC FROMDOC(&DOC) FROMFLR(&FLR) TOFLR(&STRFLR) REPLACE(*YES) MONMSG MSGID(CPF8A13) EXEC(DO) SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Unexpected + errors occurred, possibly caused by: (a) No documents in + the folder, or (b) the folder is not found') MSGTYPE(*ESCAPE) RETURN ENDDO IF COND(&ENDLOOP) THEN(RETURN) IF COND(&DOC *EQ &QDLDNM) THEN(GOTO CMDLBL(CPYLOOP)) ELSE CMD(GOTO CMDLBL(SKIPRCVF)) ENDPGM
LATEST COMMENTS
MC Press Online