XLS

Multi-Value Query directly to spreadsheets

USE LIKE SORT BUT OUTPUT GOES DIRECTLY TO A SPREADSHEET.

First, a few assumptions:

Setup a q-pointer called XLS.FOLDER to your common spreadsheets folder.
Columns are determined by spaces in the output, top to bottom. If the columns are wrong after running, 
use dictionaries without spaces in the heading.
On spreadsheets with Multi-Values, single values are repeated on each row. This allows better sorting and filtering.
The first column must always be the key (item id). You can always (re)move this after the spreadsheet is created.
Copy and paste the following at TCL in your developement account:







CREATE.BFILE BP.WRM 67





ED BP.WRM XLS
I
************************************************************
******************** XLS
************************************************************
      PROGRAM = "XLS"
******************** PROGRAMMERS LOG ********************
* 08-29-18 WRM NONE COMBINED XLS & XLS2 (REPEAT SINGLE VALUED FIELDS).
* 05-07-18 WRM NONE ALL WORDS BEFORE FILE.NAME WILL BE FORMED INTO SS.NAME.
* 12-22-16 WRM 20090 REMOVED FINAL 'STOP' SO IT CAN BE RUN FROM A PARAGRAPH.
* 07-19-13 WRM 11684 CHANGED 'TERM 132,...' TO 'TERM 80,...'
* 04-25-13 WRM NONE. BUG FIX IN MAX.LENGTH
* 01-25-12 WRM 11214 REMOVE '.' IN HEADINGS.
* 07/02/10 JBS 10768: ADD ERROR NOTE FOR NO ITEMS AND REMOVE BLANK LINE
* 07-01-10 * ISSUE #10155 * DCM * REVISED FOR PHANTOM PROCESSING
* REQUIRED USER.ID TO BE PASSED ALONG WITH PROGRAM NAME
* BILLM - 11/27/2007 - ADDED PASSLIST
* BILLM - 11/20/2007 - ALIGN ALL CELLS LEFT.
* WRM - 10/09/2007 - PUT USER.ID IN K.OUTPUT
* WRM - 09/26/2007 - REMOVE [H[2J
* WRM - 09/24/2007 - REMOVED STMT DISPLAY AS THIS,  MESSING UP PHANTOM
* WRM - 04/25/2007 - REMOVE BLANK LINES.
* WRM - 04/11/2007 - REMOVE EMPTY COLUMNS.
* WRM - 04/11/2007 - CREATED.
*********************************************************
* PURPOSE: USED LIKE 'SORT' VERB, ONLY OUTPUT IS IN MS EXCEL FORMAT.
*
      AM = CHAR(254)
      VM = CHAR(253)
      SVM = CHAR(252)
      BELL = CHAR(7)
      TAB = CHAR(9)
      CR = CHAR(13)
      LF = CHAR(10)
      CRLF = CR:LF
      WHO = @LOGNAME
      ACCOUNT = @WHO
      IF INDEX(ACCOUNT,'-',1) THEN ACCOUNT = FIELD(ACCOUNT,'-',2)
      USER.ID = FIELD(WHO,'\',2)
      USER.ID = OCONV(USER.ID,'MCU')
      IF USER.ID = 'HC' THEN USER.ID = 'WRM'
      IF OCONV(@TTY,'MCU') = 'PHANTOM' THEN USER.ID = 'PHANTOM'
      TODAY = DATE()
      OTODAY = OCONV(TODAY,'D4/')
      MONTH = FIELD(OTODAY,'/',1)
      DAY = FIELD(OTODAY,'/',2)
      YEAR = FIELD(OTODAY,'/',3)
      NOW = TIME()
      TIME = OCONV(NOW, 'MT')
      RV.ON = @(-13)
      RV.OFF = @(-14)
*
      INVALID = ""
      NOTHING = ""
      FOR XXX = 0 TO 31
         INVALID = INVALID:CHAR(XXX)
      NEXT XXX
      FOR XXX = 127 TO 250
         INVALID = INVALID:CHAR(XXX)
      NEXT XXX
*
      OPEN 'XLS.FOLDER' TO F.OUTPUT ELSE STOPM 'UNABLE TO OPEN XLS.FOLDER'
      PATH = OCONV('XLS.FOLDER','TVOC;X;3;3')
      PROMPT ''
      NIF = ''
      COL.DELIM = ''
      HEAD.DELIM = ''
      R.OUTPUT = ''
      R.OUTPUT<-1> = ''
      R.OUTPUT<-1> = ''
      SENTENCE = @SENTENCE
      SS.NAME = ''
      FILE.NAME = ''
      FOR CNT = 2 TO 99
         FILE.NAME = FIELD(SENTENCE,' ',CNT)
         OPEN FILE.NAME TO TEST THEN
            FOR TEMP = 2 TO CNT-1
               WORD = FIELD(SENTENCE,' ',TEMP)
               SS.NAME = SS.NAME:' ':WORD
            NEXT TEMP
            EXIT
         END
      NEXT CNT
      IF FILE.NAME = '' THEN STOPM 'UNABLE TO DETERMINE FILE.NAME'
      POS = INDEX(SENTENCE,' ',CNT)+1
      ROS = SENTENCE[POS,99999]
      IF SS.NAME = '' THEN SS.NAME = FILE.NAME
      CONVERT '.' TO ' ' IN SS.NAME
      CONVERT '/\' TO '--' IN SS.NAME
      SS.NAME = OCONV(SS.NAME,'MCT')
      CONVERT INVALID TO NOTHING IN SS.NAME
      CONVERT ' ' TO '' IN SS.NAME
*
      K.OUTPUT = USER.ID
      K.OUTPUT = K.OUTPUT:'-':SS.NAME
*
      K.OUTPUT := '-':YEAR:MONTH:DAY:'.xls'
      CONVERT '/' TO '' IN K.OUTPUT
      STMT = 'SORT ':FILE.NAME:' ':ROS
      IF NOT(INDEX(STMT,'HDR.SUP',1)) THEN STMT = STMT:' HDR.SUP'
      IF NOT(INDEX(STMT,'COUNT.SUP',1)) THEN STMT = STMT:' COUNT.SUP'
      EXECUTE 'TERM 32000,32000'
      CRT @(-1):@(30,0):'XLS DATA EXPORT UTILITY'
      CRT
      CRT 'SELECTING DATA...':
      EXECUTE STMT PASSLIST CAPTURING OUTPUT
      CRT
      IF OUTPUT = '' THEN
         NIF = 'NO ITEMS FOUND.'
         CRT NIF
         GO BOTTOM
      END
      CONVERT INVALID TO NOTHING IN OUTPUT
      OUTPUT = CHANGE(OUTPUT,'[H[2J','')
      CRT
      CRT 'DEFINING COLUMNS...':
      CRT
      MAX.LENGTH = 1
      LAST.LINE = DCOUNT(OUTPUT,@AM)
      FOR LINE = 1 TO LAST.LINE
* USED TO START AT LINE 5 BUT SOMETIMES THE HEADING IS THE MAX.LENGTH.
         IF LEN(OUTPUT) > MAX.LENGTH THEN MAX.LENGTH = LEN(OUTPUT)
* ALSO REMOVED CODE HERE THAT ATTEMPTED TO DELETE BLANK LINES.
      NEXT LINE
      LAST.LINE = DCOUNT(OUTPUT,@AM)
      COLUMNS = ''
* COLUMNS<1> = POSITION OF COLUMN DELIMITERS
* COLUMNS<2> = IS COLUMN MULTI-VALUED? (BOOLEAN)
*
      FOR COL = 1 TO MAX.LENGTH
         COLUMNS<1,COL> = COL
      NEXT COL
      FOR LINE = (LAST.LINE-1) TO 1 STEP -1
         STRING = OUTPUT
         FOR COL = 1 TO MAX.LENGTH
            IF TRIM(STRING[COL,1]) # '' THEN
               LOCATE COL IN COLUMNS<1> SETTING POS THEN
                  COLUMNS = DELETE(COLUMNS,1,POS,0)
               END
            END
         NEXT COL
      NEXT LINE
* THE FOLLOWING STEP IS NECESSARY IN AN ATTEMPT TO REMOVE EMPTY COLUMNS:
      FOR CNT = 1 TO CNT+1 UNTIL COLUMNS<1,CNT> = ''
         IF COLUMNS<1,CNT> + 1 = COLUMNS<1,CNT+1> THEN
            COLUMNS = DELETE(COLUMNS,1,CNT,0)
            CNT = CNT -1
         END
      NEXT CNT
      COLUMNS = '0':@VM:COLUMNS
*
* AT THIS POINT, COLUMNS SHOULD BE PROPERLY DEFINED.
*
      CRT
      CRT 'CREATING OUTPUT...':
      CRT
      HEADING.DONE = ''
      NBR.COLUMNS = DCOUNT(COLUMNS<1>,@VM)
      FOR LINE = 1 TO LAST.LINE
         STRING = OUTPUT
         IF NOT(HEADING.DONE) AND TRIM(STRING) = '' THEN HEADING.DONE = 1
         IF TRIM(STRING) = '' THEN CONTINUE        ; * SKIP BLANK LINE
         IF HEADING.DONE THEN
            DELIM = COL.DELIM
            NEW.STRING = ' {tr bgcolor=white}{td align=left} '
            IF TRIM(STRING[1,COLUMNS<1,2>-1]) # "" THEN
* COLUMN 1 MUST BE SINGLE VALUED AND REQUIRED.
               NEW.ITEM = 1
               STRING1 = STRING
            END ELSE
               NEW.ITEM = 0
            END
         END ELSE
            DELIM = HEAD.DELIM
            NEW.STRING = ' {tr bgcolor=lightyellow}{th} '
            NEW.ITEM = ''
            STRING1 = ''
         END
         FOR CNT = 1 TO NBR.COLUMNS
            COL = COLUMNS<1,CNT> + 1
            LENGTH = ABS(COLUMNS<1,CNT+1> - COL)
            SUB.STRING = STRING[COL,LENGTH]
            IF HEADING.DONE AND NOT(NEW.ITEM) THEN
               IF TRIM(SUB.STRING) # "" THEN
                  COLUMNS<2,CNT> = 1     ; * MULTI-VALUED COLUMN.
               END ELSE
                  * REPEAT SINGLE VALUED COLUMNS, BUT NOT MULTI-VALUED ONES.
                  IF NOT(COLUMNS<2,CNT>) THEN SUB.STRING = STRING1[COL,LENGTH]
               END
            END
            IF TRIM(SUB.STRING) = '' THEN SUB.STRING = ' '
            IF CNT > 1 THEN
               NEW.STRING = NEW.STRING:DELIM:SUB.STRING
            END ELSE
               NEW.STRING = NEW.STRING:SUB.STRING
            END
         NEXT CNT
         IF HEADING.DONE THEN
            NEW.STRING = NEW.STRING:"{/td}{/tr}"
         END ELSE
            NEW.STRING = NEW.STRING:"{/th}{/tr}"
            CONVERT "." TO " " IN NEW.STRING       ; * REMOVE ELIPSES IN HEADING.
         END
         R.OUTPUT<-1> = NEW.STRING
      NEXT LINE
      R.OUTPUT<-1> = '{/table}'
      R.OUTPUT<-1> = '{/body}'
      R.OUTPUT<-1> = '{/html}'
      CRT
      CRT 'WRITING ':PATH:'\':K.OUTPUT
      CRT
      CRT NIF
      CRT
      WRITE R.OUTPUT ON F.OUTPUT, K.OUTPUT
BOTTOM:*
      EXECUTE 'TERM 80,24'
*
   END


T
R,{,<,G9999


T
R,},>,G9999

FORMAT


FI