Tweet
create XML from RPG read as EXCEL
This program produces the below spreadsheet.
It writes XML to IFS which is then read automagically
by excel.
I attached program as well as the XMLit created...
It writes XML to IFS which is then read automagically
by excel.
I attached program as well as the XMLit created...
Code:
H dftactgrp( *no ) bnddir( 'QC2LE') OPTION(*NODEBUGIO)
* --------------------------------------------------
* Program - EXCEL
* Purpose -
* Written -
* Author -
*
* PROGRAM DESCRIPTION
* create example XML to view as excel
*
* INPUT PARAMETERS
* Description Type Size How Used
* ----------- ---- ---- --------
*
*
* INDICATOR USAGE
* xx - xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
*---------------------------------------------------
*
*
d Buf s 65000A
d BufP s * INZ(%ADDR(Buf))
d BufLen s 10U 0
d CmdString s 10000
d CmdLength s 15 5
d company s 2s 0
d Complete s 1
d count s 5 0
d count2 s 5 0
d cp s 10U 0 INZ(819)
d CR c CONST(X'0d')
d CRLF c CONST(X'0d25')
d Current s 1
d cymd s 7 0
d Data s 65000
d dbxfil s 10
d dbxlib s 10
d dbxown s 10
d dbxtxt s 50
d dbxatr s 2
d deleted s n
d DQ c CONST('"')
d FileNam s 15A inz('/xml/jamie2.xml')
d FileName1 s 21
d FileName2 s 21
d FileNamP s * inz(%ADDR(FileNam))
d FileDescr s 10I 0
d FirstNew s 1
d formated s 7
d formatBack s 65535A varying
d From c CONST(',"''')
d header s 65000
d ISODate s D
d LC# s 3 0
d LaborCodes s 3 dim(100)
d LaborCodeCu s 1 dim(100)
d LaborCodeCo s 1 dim(100)
d LaborCodePd s 7 0 dim(100)
d Len s 3 0
d Length s 9
d Lilian s 10i 0
d NewDate s 52a
d NLZero s 2A INZ(X'1500')
d O_CREAT s 10I 0 INZ(8)
d O_RDWR s 10I 0 INZ(4)
d O_TEXTDATA s 10I 0 INZ(16777216)
d O_CODEPAGE s 10I 0 INZ(8388608)
d Oflag s 10I 0 INZ(0)
d Omode s 10U 0 INZ(511)
d Pos s 4 0
d Produced s 7 0
d Q c CONST('''')
d ReadOneRecord s 1
d reporttype s 20
d RC s 10I 0
d savecustomer s 5 0
d savelib s 10
d SI_Fmt s 50A INZ('\n')
d SI_FmtP s * INZ(%ADDR(SI_Fmt))
d SI_Msg s 50A
d SI_MsgP s * INZ(%ADDR(SI_Msg))
d sqlrecords s 9 0
d sqlstmt s 23000 varying
d Str s 3 0
d style s 65000
d To c CONST(' ')
d useweight s 7 0
d Width s 7
d WKSDES s 30
d Workread s 3 0
d x s 2 0
d ZeroBin s 1A INZ(*ALLX'00')
*
* Program Info
*
d SDS
d @PGM 001 010
d @PARMS 037 039 0
d @JOB 244 253
d @USER 254 263
d @JOB# 264 269 0
*
d openList pr
d FetchNext pr n
d closeList pr
*
d Num_DS DS
d Num_Hex 4A INZ(X'00000000')
d Num 10I 0 OVERLAY(Num_Hex)
dperror PR 10I 0 EXTPROC('perror')
dconst * VALUE
dsprintf PR 10I 0 EXTPROC('sprintf')
d * VALUE
d * VALUE
d 10I 0 VALUE OPTIONS(*NOPASS)
d * VALUE OPTIONS(*NOPASS)
* Open Operations
* value returned = file descriptor 0 (OK), -1 (Error)
dopen PR 10I 0 EXTPROC('open')
d * VALUE
d 10I 0 VALUE
d 10U 0 VALUE OPTIONS(*NOPASS)
d 10U 0 VALUE OPTIONS(*NOPASS)
* Read Operations
* value returned = number of bytes read or , -1 (Error)
Dread PR 10I 0 EXTPROC('read')
d 10I 0 VALUE
d * Value
d 10U 0 VALUE
* Write Operations
* value returned = number of bytes Written or , -1 (Error)
dwrite PR 10I 0 EXTPROC('write')
d 10I 0 VALUE
d * VALUE
d 10U 0 VALUE
* Close Operations
* value returned = 0 (OK) or , -1 (Error)
dclose PR 10I 0 EXTPROC('close')
d 10I 0 VALUE
* Open Directory Operation
* value returned = file descriptor 0 (OK), -1 (Error)
dopendir PR * EXTPROC('opendir')
d * VALUE
* Read Directory Operation
*
dreaddir PR * EXTPROC('readdir')
d * VALUE
* Open Directory Operation
* value returned = 0 (OK) or , -1 (Error)
dclosedir PR 10I 0 EXTPROC('closedir')
d * VALUE
* Unlink a File from system... Delete File
* value returned = 0 (OK) or , -1 (Error)
dunlink PR 10I 0 EXTPROC('unlink')
d path * Value options(*string)
d CEEDAYS pr opdesc
d InputDate 65535A const options(*varsize)
d picture 65535A const options(*varsize)
d Lilian 10i 0
d Feedback 12a options(*omit)
d CEEDATE pr opdesc
d Lilian 10i 0
d picture 65535A const options(*varsize)
d OutputDate 65535A const options(*varsize)
d Feedback 12a options(*omit)
/Free
exsr $buildifs;
exsr $readfile;
clear data;
data = '</Workbook>' + CRLF;
Buf = %trim(Data);
BufLen = %scan(CRLF:Buf);
RC = write(filedescr: BufP: BufLen);
RC = close(FileDescr);
if FileDescr = -1;
RC = perror(FileNamP);
Return;
endif;
*inlr = *on;
//--------------------------------------------------------
// $buildIFS - build the temp table in IFS
//--------------------------------------------------------
begsr $buildIFS;
Filenam = %trim('/xml/jamie.xml');
Filenamp = %ADDR(FileNam);
Oflag = O_CREAT + O_RDWR + O_CODEPAGE;
FileDescr=open(FileNamP:Oflag:Omode:cp);
if FileDescr = -1;
RC = perror(FileNamP);
return;
endif;
RC = close(FileDescr);
if RC = -1;
RC = perror(FileNamP);
return;
endif;
Oflag = O_RDWR + O_TEXTDATA;
FileDescr=open(FileNamP:Oflag);
if FileDescr = -1;
RC = perror(FileNamP);
Return;
endif;
// Write the header
Buf = %trim(Data) + CRLF;
BufLen = %scan(CRLF:Buf);
RC = write(filedescr: BufP: BufLen);
clear DATA;
endsr;
//--------------------------------------------------------
// $readfile - pretend to read file of libs
//--------------------------------------------------------
begsr $readfile;
for count2 = 1 to 5; // replace with your libraries
select;
when count2 = 1;
saveLib = 'JAMIELIB';
when count2 = 2;
saveLib = 'QGPL';
when count2 = 3;
saveLib = 'QSYS';
when count2 = 4;
saveLib = 'QRPG';
when count2 = 5;
saveLib = 'QUSRSYS';
endsl;
exsr $header;
exsr $detail;
exsr $footer;
endfor;
endsr;
//--------------------------------------------------------
// $header - write the header for the excel sheet.
//--------------------------------------------------------
begsr $header;
data =
'<Worksheet ss:Name=' + DQ + %trim(saveLib) + DQ + '>' + cr +
'<Table ' +
' x:FullColumns="1"' +
' x:FullRows="1">' + cr +
'<Column ss:AutoFitWidth="0" ss:Width="39.75"/>' +cr +
'<Column ss:AutoFitWidth="0" ss:Width="90" ss:Span="1"/>' +cr +
'<Column ss:Index="9" ss:AutoFitWidth="0" ss:Width="69.75"/>'+crlf;
Buf = %trim(Data);
BufLen = %scan(CRLF:Buf);
RC = write(filedescr: BufP: BufLen);
clear data;
// add new heading
data =
'<Row ss:Height="14.25"> ' +cr +
' <Cell ss:MergeAcross="8" ss:StyleID="s22"> '+cr +
' <Data ss:Type="String">' +cr +
' Files Listed from QADBXFIL' +
cr + ' </Data></Cell>'+cr +
'</Row>' + cr ;
// write the five column headings
data = %trim(data) + cr +
' <Row>' +
' <Cell ss:StyleID="s23"><Data ss:Type="String">' +
'File' +
' </Data></Cell>' +
cr +
' <Cell ss:StyleID="s23"><Data ss:Type="String">' +
'Library' +
' </Data></Cell>' +
cr +
' <Cell ss:StyleID="s23"><Data ss:Type="String">' +
'Owner' +
' </Data></Cell>' +
cr +
' <Cell ss:StyleID="s23"><Data ss:Type="String">' +
'Description' +
' </Data></Cell>' +
cr +
' <Cell ss:StyleID="s23"><Data ss:Type="String">' +
'Attribute' +
' </Data></Cell>' +
cr +
' </Row> ' + crlf ;
Buf = %trim(Data);
BufLen = %scan(CRLF:Buf);
RC = write(filedescr: BufP: BufLen);
clear data;
endsr;
//--------------------------------------------------------
// $detail - get detail for current salesperson for today
//--------------------------------------------------------
begsr $detail;
sqlstmt = 'select ' +
'dbxfil,dbxlib,dbxown,dbxtxt,dbxatr ' +
' from QADBXFIL ' +
' where DBXLIB = ' + Q+ %trim(saveLib) + Q ;
openList();
dow fetchNext();
exsr $writerow;
enddo;
closeList();
endsr;
//--------------------------------------------------------
// $writerow - write detail row of spread sheet
//--------------------------------------------------------
begsr $writerow;
dbxtxt = %xlate('/':' ': dbxtxt);
dbxtxt = %xlate('*':' ': dbxtxt);
for count = 1 to 05;
select;
when count = 1;
data = cr + '<Row>' + CR +
'<Cell><Data ss:Type="String">' +
%trim(dbxfil) + '</Data></Cell>' + cr ;
when count = 2;
data = %trim(data) + CR +
'<Cell ss:StyleID="s24"><Data ss:Type="String">' +
%trim(dbxlib) +
'</Data></Cell>' + cr;
when count = 3;
data = %trim(data) + CR +
'<Cell ss:StyleID="s24"><Data ss:Type="String">' +
%trim(dbxown) +
'</Data></Cell>' + cr;
when count = 4;
data = %trim(data) + CR +
'<Cell ss:StyleID="s24"><Data ss:Type="String">' +
%trim(dbxtxt) +
'</Data></Cell>' + cr;
when count = 5;
data = %trim(data) + CR +
'<Cell ss:StyleID="s24"><Data ss:Type="String">' +
%trim(dbxatr) +
'</Data></Cell>' + cr;
endsl;
endfor;
data = %trim(data) + cr + '</Row>' + CRLF;
Buf = %trim(Data);
BufLen = %scan(CRLF:Buf);
RC = write(filedescr: BufP: BufLen);
clear DATA;
endsr;
//--------------------------------------------------------
// $footer - close all the tags
//--------------------------------------------------------
begsr $footer;
// write footer
data =
' </Table>' + cr +
' <WorksheetOptions xmlns="urn:schemas-microsoft-com:' +
'office:excel">' + cr +
' <TabColorIndex>47</TabColorIndex>' + cr +
' <ProtectObjects>False</ProtectObjects>' +cr +
' <ProtectScenarios>False</ProtectScenarios>' + cr +
' </WorksheetOptions>' + cr +
' </Worksheet>' + crlf ;
Buf = %trim(Data);
BufLen = %scan(CRLF:Buf);
RC = write(filedescr: BufP: BufLen);
clear DATA;
endsr;
//--------------------------------------------------------
// *inzsr - initial one time run subroutine
//--------------------------------------------------------
begsr *inzsr;
// get todays date in cymd format
isodate = %date();
// build the headers for the xml
header =
'<?xml version="1.0"?>' + CR +
'<?mso-application progid="Excel.Sheet"?>' + CR +
'<Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet"' +
CR +
'xmlns:o="urn:schemas-microsoft-com:office:office"' +
CR +
'xmlns:x="urn:schemas-microsoft-com:office:excel"' +
CR +
'xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet"' +
CR +
'xmlns:html="http://www.w3.org/TR/REC-html40">' +
CR +
'<DocumentProperties xmlns="urn:schemas-microsoft-com' +
':office:office">' + CR +
'<Author>Author</Author>' + CR +
'<LastAuthor>flanary</LastAuthor>' + CR +
'<Created>2008-05-10T01:38:01Z</Created>' + CR +
'<Version>11.9999</Version>' + CR +
'</DocumentProperties>' + CR +
'<ExcelWorkbook xmlns="urn:schemas-microsoft-com:office:excel">' +CR +
'<WindowHeight>7755</WindowHeight>' + CR +
'<WindowWidth>15225</WindowWidth>' + CR +
'<WindowTopX>0</WindowTopX>' + CR +
'<WindowTopY>255</WindowTopY>' + CR +
'<ActiveSheet>1</ActiveSheet>' + CR +
'<ProtectStructure>False</ProtectStructure>' +CR +
'<ProtectWindows>False</ProtectWindows>' +CR +
'</ExcelWorkbook> ' + CR ;
style =
'<Styles>' + CR +
'<Style ss:ID="Default" ss:Name="Normal">' + CR +
'<Alignment ss:Vertical="Bottom"/>'+ CR +
'<Borders/>' + CR +
'<Font/>' + CR +
'<Interior/>' + CR +
'<NumberFormat/>'+ CR +
'<Protection/>'+ CR +
'</Style>' + CR +
'<Style ss:ID="s22">' + CR +
'<Alignment ss:Horizontal="Left" ss:Vertical="Bottom"/>' +CR +
'<Font x:Family="Swiss" ss:Size="11" ss:Color="#000080"/>'+CR+
'</Style>' + CR +
'<Style ss:ID="s23">' + CR +
'<Alignment ss:Horizontal="Center" ss:Vertical="Bottom"/>'+CR+
'<Font x:Family="Swiss" ss:Color="#0000FF" ss:Bold="1"/>' +CR+
'</Style>' + CR +
'<Style ss:ID="s24">' + CR +
'<NumberFormat ss:Format="Standard"/>' + CR +
'</Style>' + CR +
'<Style ss:ID="s25">' + CR +
'<Alignment ss:Horizontal="Center" ss:Vertical="Bottom"/>'+CR+
'<NumberFormat ss:Format="Standard"/>' + CR +
'<Font x:Family="Swiss" ss:Color="#0000FF" ss:Bold="1"/>' +CR+
'</Style>' + CR +
'<Style ss:ID="s26">'+ CR +
'<Borders>' + CR +
'<Border ss:Position="Bottom" ss:LineStyle="Double" ss:Weight="3"/>' +
CR +
'<Border ss:Position="Top" ss:LineStyle="Continuous" ss:Weight="1"/>'+
CR +
'</Borders>' + CR +
'<NumberFormat ss:Format="Standard"/>' + CR +
'</Style>' + CR +
'<Style ss:ID="s27">' + CR +
'<Borders>'+ CR +
'<Border ss:Position="Bottom" ss:LineStyle="Double" ss:Weight="3"/>' +
CR +
'<Border ss:Position="Top" ss:LineStyle="Continuous" ss:Weight="1"/>'+
CR +
'</Borders>' + CR +
'<NumberFormat ss:Format="Percent"/>'+ CR +
'</Style>' + CR +
'</Styles>' + CR;
data = %trim(header) + CR + %trim(style) ;
CEEDAYS(%char(isodate): 'YYYY-MM-DD': lilian: *omit);
formatBack = 'Wwwwwwwwwz, DD Mmmmmmmmmz YYYY';
CEEDATE(Lilian: Formatback : NewDate: *omit);
// this ===> Wednesday, 27 June 2007
endsr;
/End-Free
*--------------------------------------------------------
* openList - Open a cursor to read file
*--------------------------------------------------------
p openList b
d openList pi
/Free
exec sql
declare MyCursor cursor for statement;
exec sql
prepare statement from :sqlstmt;
exec sql
open mycursor;
/End-Free
p openList e
*--------------------------------------------------------
* fetchNext - read one record at a time
*--------------------------------------------------------
p fetchNext b
d fetchNext pi n
/free
exec sql
fetch next from mycursor into : dbxfil ,
: dbxlib ,
: dbxown ,
: dbxtxt ,
: dbxatr ;
if sqlstt < '02000';
return *on;
else;
return *off;
endif;
/end-free
p fetchNext e
*--------------------------------------------------------
* closeOrderList - Close the OrderHdr cursor
*--------------------------------------------------------
p closeList b
d closeList pi
/free
exec sql
close MyCursor;
/end-free
p closeList e
Attached Files
Comment