SCI.XLSX.RECALL
From Pickwiki
Jump to navigationJump to search
Since Office 2010, the internal format used for Office documents has switched to a zipped collection of XML files. Since these are "just" text files, it's reasonable to attempt to produce them directly from a PICK Basic program, and this is certainly feasible. Trying to reverse-engineer the xlsx XML schema can be challenging - Excel throws everything and the kitchen sink into the zip file, and small errors lead to Excel rejecting the entire file. Polymath Programmer has some excellent resources to explain what's going on at just the right level of detail. Well worth buying the book, and the free code if you're using DotNet.
The code below is an example of creating the XML files and zipping them to produce a file that can be opened natively in Excel. If the wiki formatting causes any problems, the latest version can be retrieved from: https://github.com/ianmcgowan/SCI.BP/blob/master/SCI.XLSX.RECALL
***************************************************************************
* Program: SCI.XLS.RECALL
* Author : MCGOWJ01
* Date : 2017-02-10
* Edited :
* Comment: Convert a recall into an excel sheet
***************************************************************************
* LOG DATE BY CHANGE
* ---------- ------------ -------------------------------------------------
* SEE: https://blogs.msdn.microsoft.com/brian_jones/2006/11/02/simple-spreadsheetml-file-part-1-of-3/
* http://polymathprogrammer.com/2010/01/11/custom-column-widths-in-excel-open-xml/
*
DEBUG=0
S=@SENTENCE
FILE.NAME=FIELD(S,' ',2)
IF INDEX(FILE.NAME,'/',1) = 0 THEN STOP FILE.NAME:' is not a directory'
OPENSEQ FILE.NAME TO INPUT.F ELSE STOP 201,FILE.NAME
OUTPUT.DIR=FILE.NAME:'.TMP'
EXECUTE '!rm -rf ':OUTPUT.DIR ;* Maybe check the filename isn't ./.. before this?
EXECUTE '!mkdir ':OUTPUT.DIR
EXECUTE '!mkdir ':OUTPUT.DIR:'/_rels'
EXECUTE '!mkdir ':OUTPUT.DIR:'/xl'
EXECUTE '!mkdir ':OUTPUT.DIR:'/xl/_rels'
EXECUTE '!mkdir ':OUTPUT.DIR:'/xl/worksheets'
* This next command unzips an empty excel sheet for us to work with
*EXECUTE '!cd ':OUTPUT.DIR:' ; unzip /info/local/bin/template.xlsx' CAPTURING DUMMY
OPEN 'RECALLS' TO RECALLS ELSE STOP 201,'RECALLS'
GOSUB GET.FIELD.NAMES
IF DEBUG THEN
PRINT 'FIELD.MAP'
FOR F=1 TO DCOUNT(FIELD.MAP<1>,@VM)
PRINT F'R#2':' ':FIELD.MAP<6,F>'L#20':' ':FIELD.MAP<2,F>'L#35':' ':FIELD.MAP<3,F>
NEXT F
END
CONTROL.CHARS=''
FOR CHARACTER = 127 TO 249
CONTROL.CHARS:=CHAR(CHARACTER)
NEXT CHARACTER
*
GOSUB XLS.HEADER
ROW.COUNT=0
LOOP
READSEQ ROW FROM INPUT.F ELSE EXIT
ROW.COUNT+=1
GOSUB XLS.BODY
REPEAT
*GOSUB XLS.TOTALS
GOSUB XLS.FOOTER
CLOSE OUTPUT.F
*
EXCEL.NAME=FIELD(FILE.NAME,'/',DCOUNT(FILE.NAME,'/')):'.xlsx'
EXECUTE '!cd ':OUTPUT.DIR:' ; zip -r ':EXCEL.NAME:' *' CAPTURING DUMMY
RECIP='' ; FROM.USER='' ; CC.USER='' ;* Let the SUBR figure it out
MSG='Please find your report attached'
SUBJECT='REPORT:':EXCEL.NAME
ATTACH=OUTPUT.DIR:'/':EXCEL.NAME
OPTIONS=''
CALL SCI.MAIL.SUB(RECIP, FROM.USER, CC.USER, MSG, ATTACH, SUBJECT, OPTIONS)
STOP
*
XLS.BODY:
L='<x:row>' ; GOSUB WRITE.LINE
CONVERT '^' TO @VM IN ROW
FOR C=1 TO DCOUNT(ROW<1>,@VM)
CELL=ROW<1,C>
GOSUB URL.ENCODE.CELL
FORMAT=FIELD.MAP<3,C>
CELL.NUM=CELL ; CONVERT ',' TO '' IN CELL.NUM
BEGIN CASE
CASE FORMAT[1,1]='D' AND ICONV(CELL,'D') # '' ;* Date
CELL=ICONV(CELL,'D')+24837 ;* 12/31/1967-12/31/1899=24837
L='<x:c s="1" t="Date"><x:v>':CELL:'</x:v></x:c>'
CASE FORMAT[1,2]='MD' OR FORMAT[1,2]='MR' ;* Number
CONVERT ',' TO '' IN CELL
IF NUM(CELL) THEN
L='<x:c s="3"><x:v>':CELL:'</x:v></x:c>'
END ELSE
L='<x:c t="str"><x:v>':CELL:'</x:v></x:c>'
END
CASE 1 ;* String is default type
IF NUM(CELL.NUM) AND CELL.NUM#'' THEN
* It's a number, but leave is unstyled so zip 90210 doesn't become 90210.00
L='<x:c><x:v>':CELL:'</x:v></x:c>'
END ELSE
L='<x:c t="str"><x:v>':CELL:'</x:v></x:c>'
END
END CASE
GOSUB WRITE.LINE
NEXT C
L='</x:row>'
GOSUB WRITE.LINE
RETURN
*
XLS.TOTALS:
L='<Row>'
GOSUB WRITE.LINE
FOR C=1 TO DCOUNT(FIELD.MAP<1>,@VM)
FORMAT=FIELD.MAP<3,C>
IF FORMAT[1,2]='MD' OR FORMAT[1,2]='MR' THEN
* Number col, add total to bottom row
L=' <Cell ss:Index="':C:'" ss:Formula="=SUM(R[-':ROW.COUNT:']C:R[-1]C)"><Data ss:Type="Number">0</Data></Cell>'
GOSUB WRITE.LINE
END
NEXT C
L='</Row>'
GOSUB WRITE.LINE
RETURN
*
URL.ENCODE.CELL:
* Certain characters not allowed in XML - escape them
CONVERT CONTROL.CHARS TO '' IN CELL ;* Zap unicode/other code pages
SWAP '&' WITH '&' IN CELL
SWAP '<' WITH '<' IN CELL
SWAP '>' WITH '>' IN CELL
CELL=TRIM(CELL);* No benefit to leading or trailing spaces
RETURN
*
XLS.HEADER:
* A minimal XLSX sheet consists of 6 files
* [Content_Types].xml
* _rels/.rels
* xl/_rels/workbook.xml.rels
* xl/styles.xml
* xl/workbook.xml
* xl/worksheets/sheet.xml
*
OUTPUT.FILE.NAME=OUTPUT.DIR:'/[Content_Types].xml'
GOSUB OPEN.FILE
L='<?xml version="1.0" encoding="utf-8"?>'
GOSUB WRITE.LINE
L='<Types xmlns="http://schemas.openxmlformats.org/package/2006/content-types">'
GOSUB WRITE.LINE
L=' <Default ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.sheet.main+xml" Extension="xml"/>'
GOSUB WRITE.LINE
L=' <Default ContentType="application/vnd.openxmlformats-package.relationships+xml" Extension="rels"/>'
GOSUB WRITE.LINE
L=' <Override ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.worksheet+xml" PartName="/xl/worksheets/sheet.xml"/>'
GOSUB WRITE.LINE
L=' <Override ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.styles+xml" PartName="/xl/styles.xml"/>'
GOSUB WRITE.LINE
L='</Types>'
GOSUB WRITE.LINE
*
OUTPUT.FILE.NAME=OUTPUT.DIR:'/_rels/.rels'
GOSUB OPEN.FILE
L='<?xml version="1.0" encoding="utf-8"?>'
GOSUB WRITE.LINE
L='<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships">'
GOSUB WRITE.LINE
L=' <Relationship Id="Rb5834f0a9fe74ac0" Target="/xl/workbook.xml" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument"/>'
GOSUB WRITE.LINE
L='</Relationships>'
GOSUB WRITE.LINE
*
OUTPUT.FILE.NAME=OUTPUT.DIR:'/xl/_rels/workbook.xml.rels'
GOSUB OPEN.FILE
L='<?xml version="1.0" encoding="utf-8"?>'
GOSUB WRITE.LINE
L='<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships">'
GOSUB WRITE.LINE
L=' <Relationship Id="R203d98ce4bbc4619" Target="/xl/worksheets/sheet.xml" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/worksheet"/>'
GOSUB WRITE.LINE
L=' <Relationship Id="R8dd86d2508e64fce" Target="/xl/styles.xml" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/styles"/>'
GOSUB WRITE.LINE
L='</Relationships>'
GOSUB WRITE.LINE
*
* This one controls styles and formats. It's, complicated.
OUTPUT.FILE.NAME=OUTPUT.DIR:'/xl/styles.xml'
GOSUB OPEN.FILE
L='<?xml version="1.0" encoding="utf-8"?>'
GOSUB WRITE.LINE
L='<x:styleSheet xmlns:x="http://schemas.openxmlformats.org/spreadsheetml/2006/main">'
GOSUB WRITE.LINE
* This section controls number and date formats, and is refered below by the styles. 164=0, 165=1, etc
L=' <x:numFmts count="5">'
GOSUB WRITE.LINE
L=' <x:numFmt formatCode="dd/mm/yyyy" numFmtId="164"/>'
GOSUB WRITE.LINE
L=' <x:numFmt formatCode="#,##0.0000" numFmtId="165"/>'
GOSUB WRITE.LINE
L=' <x:numFmt formatCode="#,##0.00" numFmtId="166"/>'
GOSUB WRITE.LINE
L=' <x:numFmt formatCode="@" numFmtId="167"/>'
GOSUB WRITE.LINE
L=' <x:numFmt formatCode="mm/dd/yyyy" numFmtId="168"/>'
GOSUB WRITE.LINE
L=' </x:numFmts>'
GOSUB WRITE.LINE
L=' <x:fonts count="2">'
GOSUB WRITE.LINE
L=' <x:font>'
GOSUB WRITE.LINE
L=' <x:sz val="11"/>'
GOSUB WRITE.LINE
L=' <x:name val="Calibri"/>'
GOSUB WRITE.LINE
L=' </x:font>'
GOSUB WRITE.LINE
L=' <x:font>'
GOSUB WRITE.LINE
L=' <x:sz val="11"/>'
GOSUB WRITE.LINE
L=' <x:color tint="-0.499984740745262"/>'
GOSUB WRITE.LINE
L=' <x:name val="Calibri"/>'
GOSUB WRITE.LINE
L=' </x:font>'
GOSUB WRITE.LINE
L=' </x:fonts>'
GOSUB WRITE.LINE
L=' <x:fills count="2">'
GOSUB WRITE.LINE
L=' <x:fill>'
GOSUB WRITE.LINE
L=' <x:patternFill patternType="none"/>'
GOSUB WRITE.LINE
L=' </x:fill>'
GOSUB WRITE.LINE
L=' <x:fill>'
GOSUB WRITE.LINE
L=' <x:patternFill patternType="gray125"/>'
GOSUB WRITE.LINE
L=' </x:fill>'
GOSUB WRITE.LINE
L=' <x:fill>'
GOSUB WRITE.LINE
L=' <x:patternFill patternType="solid">'
GOSUB WRITE.LINE
L=' <x:fgColor tint="0.79998168889431442"/>'
GOSUB WRITE.LINE
L=' <x:bgColor indexed="64"/>'
GOSUB WRITE.LINE
L=' </x:patternFill>'
GOSUB WRITE.LINE
L=' </x:fill>'
GOSUB WRITE.LINE
L=' </x:fills>'
GOSUB WRITE.LINE
L=' <x:borders count="1">'
GOSUB WRITE.LINE
L=' <x:border>'
GOSUB WRITE.LINE
L=' <x:left/>'
GOSUB WRITE.LINE
L=' <x:right/>'
GOSUB WRITE.LINE
L=' <x:top/>'
GOSUB WRITE.LINE
L=' <x:bottom/>'
GOSUB WRITE.LINE
L=' <x:diagonal/>'
GOSUB WRITE.LINE
L=' </x:border>'
GOSUB WRITE.LINE
L=' </x:borders>'
GOSUB WRITE.LINE
L=' <x:cellStyleXfs count="1">'
GOSUB WRITE.LINE
L=' <x:xf borderId="0" fillId="0" fontId="0" numFmtId="0"/>'
GOSUB WRITE.LINE
L=' </x:cellStyleXfs>'
GOSUB WRITE.LINE
L=' <x:cellXfs count="5">'
GOSUB WRITE.LINE
* These styles are indexed by number from the cell references with <c s="1"> picking numFmtId="165"
L=' <x:xf borderId="0" fillId="0" fontId="0" numFmtId="0" xfId="0"/>'
GOSUB WRITE.LINE
L=' <x:xf applyNumberFormat="1" borderId="0" fillId="0" fontId="0" numFmtId="14" xfId="0"/>'
GOSUB WRITE.LINE
L=' <x:xf applyNumberFormat="1" borderId="0" fillId="0" fontId="0" numFmtId="165" xfId="0"/>'
GOSUB WRITE.LINE
L=' <x:xf applyNumberFormat="1" borderId="0" fillId="0" fontId="0" numFmtId="166" xfId="0"/>'
GOSUB WRITE.LINE
L=' <x:xf applyNumberFormat="1" borderId="0" fillId="0" fontId="0" numFmtId="167" xfId="0"/>'
GOSUB WRITE.LINE
L=' <x:xf applyNumberFormat="1" borderId="0" fillId="0" fontId="0" numFmtId="168" xfId="0"/>'
GOSUB WRITE.LINE
L=' <x:xf applyNumberFormat="0" borderId="0" fillId="2" fontId="1" xfId="0"/>'
GOSUB WRITE.LINE
L=' </x:cellXfs>'
GOSUB WRITE.LINE
L=' <x:cellStyles count="1">'
GOSUB WRITE.LINE
L=' <x:cellStyle builtinId="0" name="Normal" xfId="0"/>'
GOSUB WRITE.LINE
L=' </x:cellStyles>'
GOSUB WRITE.LINE
L=' <x:dxfs count="0"/>'
GOSUB WRITE.LINE
L=' <x:tableStyles count="0" defaultPivotStyle="PivotStyleLight16" defaultTableStyle="TableStyleMedium9"/>'
GOSUB WRITE.LINE
L='</x:styleSheet>'
GOSUB WRITE.LINE
*
OUTPUT.FILE.NAME=OUTPUT.DIR:'/xl/workbook.xml'
GOSUB OPEN.FILE
L='<?xml version="1.0" encoding="utf-8"?>'
GOSUB WRITE.LINE
L='<x:workbook xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships" xmlns:x="http://schemas.openxmlformats.org/spreadsheetml/2006/main">'
GOSUB WRITE.LINE
L=' <x:fileVersion appName="Microsoft Office Excel"/>'
GOSUB WRITE.LINE
L=' <x:sheets>'
GOSUB WRITE.LINE
L=' <x:sheet name="Sheet1" r:id="R203d98ce4bbc4619" sheetId="1"/>'
GOSUB WRITE.LINE
L=' </x:sheets>'
GOSUB WRITE.LINE
L='</x:workbook>'
GOSUB WRITE.LINE
*
OUTPUT.FILE.NAME=OUTPUT.DIR:'/xl/worksheets/sheet.xml'
GOSUB OPEN.FILE
L='<?xml version="1.0"?>'
GOSUB WRITE.LINE
L='<x:worksheet xmlns:x="http://schemas.openxmlformats.org/spreadsheetml/2006/main">'
GOSUB WRITE.LINE
L=' <x:sheetData>'
GOSUB WRITE.LINE
*
* Now heading values in row 1
*
* Column definitions
FOR C=1 TO DCOUNT(FIELD.MAP<1>,@VM)
FORMAT=FIELD.MAP<3,C>
MASK=FIELD.MAP<5,C>
MASK=MASK[1,LEN(MASK)-1]
IF NOT(NUM(MASK)) THEN MASK=10
BEGIN CASE
CASE FORMAT[1,1]='D' ;* Date
STYLE='s102'
CASE FORMAT[1,2]='MD' OR FORMAT[1,2]='MR' ;* Number
IF FORMAT[3,1]='0' THEN
STYLE='s103'
END ELSE
STYLE='s101'
END
CASE 1 ;* String is default type
STYLE='Default'
END CASE
L=' <Column ss:Index="':C:'" ss:StyleID="':STYLE:'" ss:Width="':MASK*10:'"/>'
*GOSUB WRITE.LINE
NEXT C
*
* Now write a header row
*
L='<x:row>'
GOSUB WRITE.LINE
FOR C=1 TO DCOUNT(FIELD.MAP<1>,@VM)
L=' <x:c s="6" t="str"><x:v>'
*CELL=TRIM(FIELD.MAP<4,C>)
*IF CELL='' THEN CELL=FIELD.MAP<6,C>
CELL=FIELD.MAP<6,C>
GOSUB URL.ENCODE.CELL
L:=CELL
L:='</x:v></x:c>'
GOSUB WRITE.LINE
NEXT C
L='</x:row>'
GOSUB WRITE.LINE
RETURN
*
XLS.FOOTER:
L=' </x:sheetData>'
GOSUB WRITE.LINE
L='</x:worksheet>'
GOSUB WRITE.LINE
RETURN
*
OPEN.FILE:
EXECUTE '!rm -f ':OUTPUT.FILE.NAME
EXECUTE '!touch ':OUTPUT.FILE.NAME
OPENSEQ OUTPUT.FILE.NAME TO OUTPUT.F ELSE STOP 'CANNOT OPEN ':OUTPUT.FILE.NAME
RETURN
*
WRITE.LINE:
*IF DEBUG THEN PRINT L
WRITESEQ L:CHAR(13) APPEND ON OUTPUT.F ELSE STOP 'ERROR WRITING ':FILE.NAME
RETURN
*
GET.FIELD.NAMES:
FIELD.MAP=''
RECALL.NAME=FIELD(FILE.NAME,'/',DCOUNT(FILE.NAME,'/'))
READV R FROM RECALLS, RECALL.NAME, 1 ELSE STOP 'CANNOT READ RECALLS:':RECALL.NAME
DATA.FILE=''
FOR F=1 TO DCOUNT(R,@VM)
L=R<1,F>
IF FIELD(L,' ',1) = 'list' OR FIELD(L,' ',1) = 'sort' THEN
IF DATA.FILE # '' THEN STOP 'CAN ONLY PROCESS ONE list OR sort PER RECALL'
DATA.FILE=FIELD(L,' ',2)
OPEN 'DICT',DATA.FILE TO DICT ELSE STOP 'CANNOT OPEN DICT ':DATA.FILE
END
IF DATA.FILE # '' THEN
FOR WC=1 TO DCOUNT(L,' ')
* list LS.MASTER FIELD1 FIELD2 ETC.. Skip the first two
ATB=FIELD(L,' ',WC)
IF ATB='list' OR ATB='sort' THEN CONTINUE
IF ATB=DATA.FILE THEN CONTINUE
IF ATB='TO' THEN
* Stop when we get to the TO DELIM etc...
RETURN
END
READ DICT.REC FROM DICT, ATB THEN
TYPE=DICT.REC<1>
CORR=DICT.REC<2>
CONV=DICT.REC<3>
HEAD=DICT.REC<4>
MASK=DICT.REC<5>
N=DCOUNT(FIELD.MAP<1>,@VM)+1 ;* Always nervous of NULL with <1,-1>
FIELD.MAP<1,N>=TYPE
FIELD.MAP<2,N>=CORR
FIELD.MAP<3,N>=CONV
FIELD.MAP<4,N>=HEAD
FIELD.MAP<5,N>=MASK
FIELD.MAP<6,N>=ATB
END ELSE
IF ATB # 'BY' AND ATB # 'WITH' THEN
PRINT 'ATB ':ATB:' NOT FOUND IN DICT ':DATA.FILE
END
END
NEXT WC
END
NEXT F
RETURN
