789 lines
26 KiB
Plaintext
789 lines
26 KiB
Plaintext
COMPILE FUNCTION obj_Export(Method, Parms, AutoFlag)
|
|
#pragma precomp SRP_PreCompiler
|
|
|
|
|
|
/*
|
|
Methods for Export table
|
|
|
|
09/26/2006 JCH - Initial Coding
|
|
|
|
Properties:
|
|
|
|
Methods:
|
|
|
|
ExportDelimited ;* Create new record
|
|
ExportExcel
|
|
ExportTemplate
|
|
|
|
*/
|
|
|
|
|
|
DECLARE FUNCTION Get_Status, Msg, Utility, obj_Tables, NextKey, Logging_Services, Environment_Services
|
|
DECLARE SUBROUTINE Set_Status, Msg, obj_Tables, ErrMsg, Yield, RList, Msg, Logging_Services
|
|
|
|
$INSERT EXPORTS_EQU
|
|
$INSERT MSG_EQUATES
|
|
$INSERT DICT_EQUATES
|
|
$INSERT RLIST_EQUATES
|
|
|
|
EQU CRLF$ TO \0D0A\
|
|
EQU CR$ TO \0D\
|
|
EQU TAB$ TO \09\
|
|
EQU TRUE$ TO 1
|
|
EQU FALSE$ TO 0
|
|
|
|
|
|
|
|
equ xlTrue to -1
|
|
equ xlFalse to 0
|
|
equ xlSheetVisible to -1
|
|
equ xlRangeAutoFormatSimple to -4154
|
|
equ xlRangeAutoFormatClassic1 to 1
|
|
equ xlCSV to 6
|
|
equ xlWorkbookNormal to -4143
|
|
equ xlTextMSDOS to 21
|
|
equ xlCSVWindows to 23
|
|
|
|
|
|
eXcelCols = 'A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,AA,BB,CC,DD,EE,FF,GG,HH,II,JJ,KK,LL'
|
|
SWAP "','" WITH ',' IN eXcelCols
|
|
CONVERT ',' TO @VM IN eXcelCols
|
|
|
|
|
|
ErrTitle = 'Error in Stored Procedure "obj_Export"'
|
|
ErrorMsg = ''
|
|
|
|
LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\Export'
|
|
LogDate = Oconv(Date(), 'D4/')
|
|
LogTime = Oconv(Time(), 'MTS')
|
|
LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' Export Log.csv'
|
|
Headers = 'Logging DTM' : @FM : 'AutoFlag'
|
|
objLog = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, Comma$, Headers, '', False$, False$)
|
|
|
|
IF NOT(ASSIGNED(Method)) THEN ErrorMsg = 'Unassigned parameter "Method" passed to subroutine'
|
|
IF NOT(ASSIGNED(Parms)) THEN Parms = ''
|
|
If Not(Assigned(AutoFlag)) then AutoFlag = False$
|
|
|
|
LoggingDTM = LogDate : ' ' : LogTime ; // Logging DTM
|
|
LogData = ''
|
|
LogData<1> = LoggingDTM
|
|
LogData<2> = AutoFlag
|
|
Logging_Services('AppendLog', objLog, LogData, @RM, @FM)
|
|
|
|
|
|
IF ErrorMsg NE '' THEN
|
|
Set_Status(-1,ErrTitle:@SVM:ErrorMsg)
|
|
RETURN ''
|
|
END
|
|
|
|
Result = ''
|
|
|
|
BEGIN CASE
|
|
CASE Method = 'ExportDelimited' ; GOSUB ExportDelimited
|
|
CASE Method = 'ExportExcel' ; GOSUB ExportExcel
|
|
CASE Method = 'ExportTemplate' ; GOSUB ExportTemplate
|
|
CASE Method = 'ExcelCol' ; GOSUB ExcelCol
|
|
CASE 1
|
|
|
|
END CASE
|
|
|
|
IF ErrorMsg NE '' THEN
|
|
Set_Status(-1,ErrTitle:@SVM:ErrorMsg)
|
|
RETURN ''
|
|
END
|
|
|
|
RETURN Result
|
|
|
|
|
|
* * * * * * *
|
|
ExcelCol:
|
|
* * * * * * *
|
|
|
|
ColNos = Parms[1,@RM]
|
|
|
|
ColCnt = COUNT(ColNos,@VM) + (ColNos NE '')
|
|
|
|
eXcelCols = ''
|
|
|
|
FOR I = 1 TO ColCnt
|
|
ColNo = ColNos<1,I>
|
|
|
|
IF NUM(ColNo) THEN
|
|
|
|
MSig = INT(ColNo/26)
|
|
LSig = MOD(ColNo,26)
|
|
|
|
IF MSig > 0 AND LSig = 0 THEN
|
|
MSig -= 1
|
|
LSig = 26
|
|
END
|
|
|
|
IF MSig > 0 THEN
|
|
eXcelCols<1,I> = CHAR(MSig + 64):CHAR(LSig + 64)
|
|
END ELSE
|
|
eXcelCols<1,I> = CHAR(LSig + 64)
|
|
END
|
|
|
|
END ELSE
|
|
|
|
eXCelCols<1,I> = ''
|
|
END
|
|
|
|
NEXT I
|
|
|
|
Result = eXcelCols
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
ExportDelimited:
|
|
* * * * * * *
|
|
|
|
Delimiter = Parms[1,@RM]
|
|
KeyList = Parms[COL2()+1,@RM]
|
|
ExportID = Parms[COL2()+1,@RM]
|
|
DosTable = Parms[COL2()+1,@RM]
|
|
TableName = Parms[COL2()+1,@RM]
|
|
FieldNames = Parms[COL2()+1,@RM]
|
|
NoHeader = Parms[COL2()+1,@RM]
|
|
Automated = Parms[COL2()+1,@RM]
|
|
|
|
IF ExportID NE '' THEN
|
|
ExportRec = XLATE('EXPORTS',ExportID,'','X')
|
|
IF DosTable = '' THEN DosTable = ExportRec<EXPORTS_PATH$>
|
|
IF Tablename = '' THEN TableName = ExportRec<EXPORTS_TABLE$>
|
|
IF FieldNames = '' THEN FieldNames = ExportRec<EXPORTS_COLUMNS$>
|
|
END
|
|
|
|
IF Delimiter = '' THEN Delimiter = 'Comma'
|
|
IF TableName = '' THEN ErrorMsg = 'Null Parameter "TableName" passed to routine. (':Method:')'
|
|
IF FieldNames = '' THEN ErrorMsg = 'Null Parameter "FieldNames" passed to routine. (':Method:')'
|
|
IF KeyList = '' THEN ErrorMsg = 'Null Parameter "KeyList" passed to routine. (':Method:')'
|
|
IF DosTable = '' THEN ErrorMsg = 'Null Parameter "DosTable" passed to routine. (':Method:')'
|
|
|
|
IF NoHeader = '' THEN NoHeader = 0
|
|
|
|
Delimiters = 'COMMA':@VM:'TAB'
|
|
|
|
TestDelimiter = Delimiter
|
|
CONVERT @LOWER_CASE TO @UPPER_CASE IN TestDelimiter
|
|
|
|
LOCATE TestDelimiter IN Delimiters USING @VM SETTING Pos THEN
|
|
BEGIN CASE
|
|
CASE TestDelimiter = 'TAB'
|
|
DelimChar = CHAR(9)
|
|
FileExt = 'tsv'
|
|
|
|
CASE TestDelimiter = 'COMMA'
|
|
DelimChar = ","
|
|
FileExt = 'csv'
|
|
|
|
END CASE
|
|
END ELSE
|
|
ErrorMsg = 'Invalid Delimiter Parameter ':QUOTE(Delimiter):' passed to routine. (':Method:')'
|
|
RETURN
|
|
END
|
|
|
|
if Automated EQ 1 then
|
|
DosTableName = DosTable
|
|
DosTable = DosTableName
|
|
end else
|
|
DosTableName = DosTable[1,'.']
|
|
DosTable = DosTableName:'.':FileExt
|
|
end
|
|
|
|
|
|
|
|
|
|
OPEN TableName TO TableVar ELSE
|
|
ErrorMsg = 'Unable to open ':TableName:' table in Export_Delimited routine'
|
|
RETURN
|
|
END
|
|
|
|
OPEN 'DICT.':TableName TO @DICT ELSE
|
|
ErrorMsg = 'Unable to open DICT.':TableName:' table in Export_Delimited routine.'
|
|
RETURN
|
|
END
|
|
|
|
DataOut = ''
|
|
|
|
OSOPEN DosTable TO DOSFile THEN
|
|
OSWrite DataOut ON DosTable ;* Clear file it was already there
|
|
END ELSE
|
|
OSWrite DataOut ON DosTable ;* Create the file if it wasn't
|
|
OSOPEN DosTable TO DOSFile ELSE
|
|
ErrorMsg = "Unable to open ":QUOTE(DosTable):" in Export_TSV routine."
|
|
RETURN
|
|
END
|
|
END
|
|
|
|
READ Fields FROM @DICT,'%FIELDS%' ELSE
|
|
ErrorMsg = 'Unable to read %FIELDS% from DICT.':TableName:' in ExportDelimited routine.'
|
|
RETURN
|
|
END
|
|
|
|
FilePointer = 0
|
|
|
|
|
|
KeylistCnt = COUNT(KeyList,@VM) + (KeyList NE '')
|
|
|
|
Def = ""
|
|
Def<MCAPTION$> = 'Exporting ':TableName:' Data...'
|
|
Def<MTYPE$ > = "GC"
|
|
Def<MEXTENT$> = KeyListCnt
|
|
Def<MTEXTWIDTH$> = 400
|
|
|
|
HeaderOut = ''
|
|
|
|
FOR I = 1 TO COUNT(FieldNames,@VM) + (FieldNames NE '')
|
|
FieldName = FieldNames<1,I>
|
|
READV FieldHeader FROM @DICT,FieldName,DICT_DISPLAY$ THEN
|
|
HeaderOut := QUOTE(FieldHeader):DelimChar
|
|
END
|
|
NEXT I
|
|
|
|
DataOut = ''
|
|
HeaderOut[-1,1] = ''
|
|
HeaderOut := CRLF$
|
|
|
|
IF NoHeader ELSE
|
|
* OSBWrite HeaderOut ON DOSFile AT FilePointer
|
|
FilePointer += LEN(HeaderOut)
|
|
DataOut := HeaderOut
|
|
END
|
|
|
|
fnCnt = COUNT(FieldNames,@VM) + (FieldNames NE '')
|
|
|
|
|
|
FOR I = 1 TO COUNT(KeyList,@VM) + (KeyList NE '')
|
|
@ID = KeyList<1,I>
|
|
rv = 1
|
|
|
|
WHILE rv
|
|
READ @RECORD FROM TableVar,@ID THEN
|
|
|
|
FOR N = 1 TO fnCnt
|
|
FieldName = FieldNames<1,N>
|
|
LOCATE FieldName IN Fields<FIELDS_NAME$> USING @VM SETTING Pos THEN
|
|
FType = Fields<FIELDS_TYPE$,Pos>
|
|
FNo = Fields<FIELDS_FIELD_NO$,Pos>
|
|
FMV = Fields<FIELDS_MVFLAG$,Pos>
|
|
FPart = Fields<FIELDS_PART$,Pos>
|
|
FJust = Fields<FIELDS_JUST$,Pos>
|
|
FConv = Fields<FIELDS_CONV$,Pos>
|
|
|
|
IF FNo[1,1] = 0 THEN
|
|
DataVal = FIELD(@ID,'*',FPart,1) ;* Part or all of key
|
|
END ELSE
|
|
IF FType = 'F' THEN DataVal = @RECORD<FNo> ;* Real field
|
|
IF FType = 'S' THEN DataVal = Calculate(FieldName) ;* Symbolic field
|
|
END
|
|
IF FConv NE '' THEN DataVal = OCONV(DataVal,FConv) ;* Conversion if required
|
|
If Index(DataVal, '"', 1) then
|
|
Swap '"' with '""' in DataVal
|
|
end
|
|
DataOut := QUOTE(DataVal):DelimChar
|
|
|
|
END
|
|
|
|
NEXT N
|
|
|
|
DataOut[-1,1] = ''
|
|
DataOut := CRLF$
|
|
|
|
END
|
|
YIELD()
|
|
|
|
NEXT I
|
|
|
|
OSWrite DataOut to DOSFile
|
|
|
|
Def = ''
|
|
Def<MTEXT$> = 'File ':DosTable:' written.'
|
|
Def<MTYPE$> = 'TA3'
|
|
|
|
OSClose DOSFile
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
ExportExcel:
|
|
* * * * * * *
|
|
|
|
KeyList = Parms[1,@RM]
|
|
ExportID = Parms[COL2()+1,@RM]
|
|
ExcelFileName = Parms[COL2()+1,@RM]
|
|
TableName = Parms[COL2()+1,@RM]
|
|
FieldNames = Parms[COL2()+1,@RM]
|
|
|
|
IF ExportID NE '' THEN
|
|
ExportRec = XLATE('EXPORTS',ExportID,'','X')
|
|
IF ExcelFileName = '' THEN ExcelFileName = ExportRec<EXPORTS_PATH$>
|
|
IF Tablename = '' THEN TableName = ExportRec<EXPORTS_TABLE$>
|
|
IF FieldNames = '' THEN FieldNames = ExportRec<EXPORTS_COLUMNS$>
|
|
END
|
|
|
|
IF TableName = '' THEN ErrorMsg = 'Null Parameter "TableName" passed to routine. (':Method:')'
|
|
IF FieldNames = '' THEN ErrorMsg = 'Null Parameter "FieldNames" passed to routine. (':Method:')'
|
|
IF KeyList = '' THEN ErrorMsg = 'Null Parameter "KeyList" passed to routine. (':Method:')'
|
|
IF ExcelFileName = '' THEN ErrorMsg = 'Null Parameter "ExcelFileName" passed to routine. (':Method:')'
|
|
|
|
ExcelFileName = FIELD(ExcelFileName,'.',1)
|
|
ExcelFileName = ExcelFileName:'.xls' ;* Standardize the file extension if there is one
|
|
|
|
OPEN TableName TO TableVar ELSE
|
|
ErrorMsg = 'Unable to open ':TableName:' table in for Read. (':Method:')'
|
|
RETURN
|
|
END
|
|
|
|
OPEN 'DICT.':TableName TO @DICT ELSE
|
|
ErrorMsg = 'Unable to open DICT.':TableName:' table for Read. (':Method:')'
|
|
RETURN
|
|
END
|
|
|
|
DataOut = ''
|
|
|
|
READ Fields FROM @DICT,'%FIELDS%' ELSE
|
|
ErrorMsg = 'Unable to read %FIELDS% from DICT.':TableName:' in Export_TSV routine.'
|
|
RETURN
|
|
END
|
|
|
|
FilePointer = 0
|
|
|
|
Def = ''
|
|
Def<MTEXT$> = 'Exporting ':TableName:' Data...'
|
|
Def<MTYPE$> = 'U'
|
|
|
|
DataArray = ''
|
|
|
|
FOR I = 1 TO COUNT(FieldNames,@VM) + (FieldNames NE '')
|
|
FieldName = FieldNames<1,I>
|
|
READV FieldHeader FROM @DICT,FieldName,DICT_DISPLAY$ THEN
|
|
DataArray<I,1> = FieldHeader
|
|
END
|
|
NEXT I
|
|
|
|
fnCnt = COUNT(FieldNames,@VM) + (FieldNames NE '')
|
|
|
|
FOR I = 1 TO COUNT(KeyList,@VM) + (KeyList NE '')
|
|
@ID = KeyList<1,I>
|
|
READ @RECORD FROM TableVar,@ID THEN
|
|
|
|
FOR N = 1 TO fnCnt
|
|
FieldName = FieldNames<1,N>
|
|
LOCATE FieldName IN Fields<FIELDS_NAME$> USING @VM SETTING Pos THEN
|
|
FType = Fields<FIELDS_TYPE$,Pos>
|
|
FNo = Fields<FIELDS_FIELD_NO$,Pos>
|
|
FMV = Fields<FIELDS_MVFLAG$,Pos>
|
|
FPart = Fields<FIELDS_PART$,Pos>
|
|
FJust = Fields<FIELDS_JUST$,Pos>
|
|
FConv = Fields<FIELDS_CONV$,Pos>
|
|
|
|
|
|
IF FNo[1,1] = 0 THEN
|
|
DataVal = FIELD(@ID,'*',FPart,1) ;* Part or all of record key
|
|
END ELSE
|
|
IF FType = 'F' THEN DataVal = @RECORD<FNo> ;* Real field
|
|
IF FType = 'S' THEN DataVal = Calculate(FieldName) ;* Symbolic field
|
|
END
|
|
IF FConv NE '' THEN DataVal = OCONV(DataVal,FConv) ;* Conversion if required
|
|
|
|
DataArray<N,I+1> = DataVal
|
|
|
|
END
|
|
|
|
NEXT N
|
|
|
|
END
|
|
|
|
NEXT I
|
|
|
|
xlApp = OleCreateInstance("excel.Application")
|
|
OlePutProperty(XlApp, 'Visible', xlSheetVisible)
|
|
if OleStatus() then Goto HadError
|
|
|
|
|
|
xlWorkBooks =OleGetProperty(xlApp, "Workbooks")
|
|
xlWkb = OleCallMethod(xlWorkbooks,"Add")
|
|
if OleStatus() then Goto HadError
|
|
|
|
|
|
xlSht = OleGetProperty(xlWkb, "Worksheets",1)
|
|
if OleStatus() then Goto HadError
|
|
|
|
xlPageSetup = OleGetProperty(xlSht,"PageSetup")
|
|
if OleStatus() then GOTO HadError
|
|
|
|
OlePutProperty( xlPageSetup, 'PrintGridLines', xlTrue )
|
|
if OleStatus() then GOTO HadError
|
|
|
|
ColCnt = COUNT(DataArray,@FM) + (DataArray NE '')
|
|
LineCnt = COUNT(DataArray<1>,@VM) + (DataArray<1> NE '')
|
|
FOR LineNo = 1 TO LineCnt
|
|
FOR Column = 1 to ColCnt
|
|
RangeColumn = eXcelCols<1,Column>
|
|
range = OleGetProperty( xlSht, 'Range',RangeColumn:LineNo)
|
|
OlePutProperty(range, 'Value', DataArray<Column,LineNo>)
|
|
IF OleStatus() THEN GOTO HadError
|
|
NEXT Column
|
|
NEXT LineCnt
|
|
|
|
LastColumn = eXcelCols<1,ColCnt>
|
|
|
|
IF OleStatus() THEN GOTO HadError
|
|
|
|
|
|
RangeColumn = eXcelCols<1,ColCnt>
|
|
range = OleGetProperty( xlSht, 'Range','A1:':RangeColumn:LineCnt)
|
|
|
|
Void = OleCallMethod( range, 'AutoFormat', xlRangeAutoFormatClassic1 )
|
|
IF OleStatus() THEN GOTO HadError
|
|
|
|
|
|
Void = OleCallMethod( xlWkb, 'SaveAs',ExcelFileName, xlWorkbookNormal )
|
|
* No error checking -> xl closes if you don't save otherwise.
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
ExportTemplate:
|
|
* * * * * * *
|
|
|
|
ExportID = Parms[1,@RM]
|
|
TypeOver = Parms[COL2()+1,@RM]
|
|
|
|
IF ExportID = '' THEN
|
|
ErrorMsg = 'Null Parameter "ExportID" passed to routine. (':Method:')'
|
|
RETURN
|
|
END
|
|
|
|
ExportRec = XLATE('EXPORTS',ExportID,'','X')
|
|
|
|
IF ExportRec = '' THEN
|
|
ErrorMsg = 'Template ':QUOTE(ExportID):' not on file in Exports table. (':Method:')'
|
|
RETURN
|
|
END
|
|
|
|
IF TypeOver<EXPORTS_COLUMNS$> NE '' THEN ExportRec<EXPORTS_COLUMNS$> = TypeOver<EXPORTS_COLUMNS$>
|
|
IF TypeOver<EXPORTS_QUERY_COLUMNS$> NE '' THEN ExportRec<EXPORTS_QUERY_COLUMNS$> = TypeOver<EXPORTS_QUERY_COLUMNS$>
|
|
IF TypeOver<EXPORTS_QUERY_COL_FILTER$> NE '' THEN ExportRec<EXPORTS_QUERY_COL_FILTER$> = TypeOver<EXPORTS_QUERY_COL_FILTER$>
|
|
IF TypeOver<EXPORTS_PATH$> NE '' THEN ExportRec<EXPORTS_PATH$> = TypeOver<EXPORTS_PATH$>
|
|
IF TypeOver<EXPORTS_TABLE$> NE '' THEN ExportRec<EXPORTS_TABLE$> = TypeOver<EXPORTS_TABLE$>
|
|
IF TypeOver<EXPORTS_ENTRY_ID$> NE '' THEN ExportRec<EXPORTS_ENTRY_ID$> = TypeOver<EXPORTS_ENTRY_ID$>
|
|
IF TypeOver<EXPORTS_ENTRY_DATE$> NE '' THEN ExportRec<EXPORTS_ENTRY_DATE$> = TypeOver<EXPORTS_ENTRY_DATE$>
|
|
IF TypeOver<EXPORTS_SHARABLE$> NE '' THEN ExportRec<EXPORTS_SHARABLE$> = TypeOver<EXPORTS_SHARABLE$>
|
|
IF TypeOver<EXPORTS_NQUERY_COLUMNS$> NE '' THEN ExportRec<EXPORTS_NQUERY_COLUMNS$> = TypeOver<EXPORTS_NQUERY_COLUMNS$>
|
|
IF TypeOver<EXPORTS_NQUERY_COL_FILTER$> NE '' THEN ExportRec<EXPORTS_NQUERY_COL_FILTER$> = TypeOver<EXPORTS_NQUERY_COL_FILTER$>
|
|
IF TypeOver<EXPORTS_UTIL_START$> NE '' THEN ExportRec<EXPORTS_UTIL_START$> = TypeOver<EXPORTS_UTIL_START$>
|
|
IF TypeOver<EXPORTS_UTIL_END$> NE '' THEN ExportRec<EXPORTS_UTIL_END$> = TypeOver<EXPORTS_UTIL_END$>
|
|
IF TypeOver<EXPORTS_EXPAND_MV$> NE '' THEN ExportRec<EXPORTS_EXPAND_MV$> = TypeOver<EXPORTS_EXPAND_MV$>
|
|
|
|
|
|
ExcelFileName = ExportRec<EXPORTS_PATH$>
|
|
TableName = ExportRec<EXPORTS_TABLE$>
|
|
|
|
ExcelFileName = FIELD(ExcelFileName,'.',1)
|
|
ExcelFileName = ExcelFileName:'.csv' ;* Standardize the file extension if there is one
|
|
|
|
|
|
OPEN TableName TO TableVar ELSE ErrorMsg = 'Unable to open ':TableName:' table in for Read. (':Method:')'
|
|
OPEN 'DICT.':TableName TO @DICT ELSE ErrorMsg = 'Unable to open DICT.':TableName:' table for Read. (':Method:')'
|
|
READ DictFields FROM @DICT,'%FIELDS%' ELSE ErrorMsg = 'Unable to read %FIELDS% from DICT.':TableName:' in Export_TSV routine.'
|
|
|
|
IF ErrorMsg NE '' THEN RETURN
|
|
|
|
DataOut = ''
|
|
FilePointer = 0
|
|
|
|
Def = ''
|
|
Def<MTEXT$> = 'Exporting ':TableName:' Data...'
|
|
Def<MTYPE$> = 'U'
|
|
|
|
CLEARSELECT
|
|
|
|
IdxQueryColumns = ExportRec<EXPORTS_QUERY_COLUMNS$>
|
|
IdxQueryFilters = ExportRec<EXPORTS_QUERY_COL_FILTER$>
|
|
|
|
IdxColCnt = COUNT(IdxQueryColumns,@VM) + (IdxQueryColumns NE '')
|
|
|
|
IdxStatement = 'SELECT ':TableName
|
|
|
|
ValNo = 1
|
|
FOR I = 1 TO IdxColCnt
|
|
IdxColumn = IdxQueryColumns<1,I>
|
|
IdxFilter = IdxQueryFilters<1,I>
|
|
Operator = FIELD(IdxFilter, ' ', 1 )
|
|
Values = FIELD(IdxFilter,' ',2,99 )
|
|
|
|
SWAP '~' WITH 'NOT ' IN Operator
|
|
|
|
IF TRIM(Operator) = 'FROM' THEN
|
|
SWAP ' TO ' WITH '" TO "' IN Values
|
|
IF ValNo = 1 THEN
|
|
IdxStatement := ' WITH ':IdxColumn:' ':Operator:' ':QUOTE(Values)
|
|
END ELSE
|
|
IdxStatement := ' AND WITH ':IdxColumn:' ':Operator:' ':QUOTE(Values)
|
|
END
|
|
END ELSE
|
|
LOOP
|
|
Value = Values[1,' ']
|
|
UNTIL Value = ''
|
|
CONVERT "'" TO '"' IN Value
|
|
IF NOT(Value[1,1] = '"' AND Value[-1,1] = '"') THEN Value = Quote(Value) ;* Put quotes around values not already quoted
|
|
|
|
Values[1,COL2()] = ''
|
|
|
|
IF ValNo = 1 THEN
|
|
IdxStatement := ' WITH ':IdxColumn:' ':Operator:' ':Value
|
|
END ELSE
|
|
IdxStatement := ' AND WITH ':IdxColumn:' ':Operator:' ':Value
|
|
END
|
|
ValNo += 1
|
|
REPEAT
|
|
END ;* End of check for 'FROM' (Date Range) in filter
|
|
NEXT I
|
|
|
|
* Non Indexed query
|
|
|
|
NIdxQueryColumns = ExportRec<EXPORTS_NQUERY_COLUMNS$
|
|
NIdxQueryFilters = ExportRec<EXPORTS_NQUERY_COL_FILTER$>
|
|
|
|
NIdxStatement = 'SELECT ':TableName
|
|
|
|
NIdxColCnt = COUNT(NIdxQueryColumns, @VM ) + (NIdxQueryColumns NE '')
|
|
|
|
ValNo = 1
|
|
FOR I = 1 TO NIdxColCnt
|
|
NIdxColumn = NIdxQueryColumns<1,I>
|
|
NIdxFilter = NIdxQueryFilters<1,I>
|
|
Operator = FIELD(NIdxFilter, ' ', 1 )
|
|
Values = FIELD(NIdxFilter,' ',2,99 )
|
|
|
|
SWAP '~' WITH 'NOT ' IN Operator
|
|
|
|
IF TRIM(Operator) = 'FROM' THEN
|
|
SWAP ' TO ' WITH '" TO "' IN Values
|
|
|
|
IF ValNo = 1 THEN
|
|
NIdxStatement := ' WITH ':NIdxColumn:' ':Operator:' ':QUOTE(Values)
|
|
END ELSE
|
|
NIdxStatement := ' AND WITH ':NIdxColumn:' ':Operator:' ':QUOTE(Values)
|
|
END
|
|
END ELSE
|
|
LOOP
|
|
Value = Values[1,' ']
|
|
UNTIL Value = ''
|
|
CONVERT "'" TO '"' IN Value
|
|
IF NOT(Value[1,1] = '"' AND Value[-1,1] = '"') THEN Value = Quote(Value) ;* Put quotes around values not already quoted
|
|
|
|
Values[1,COL2()] = ''
|
|
|
|
IF ValNo = 1 THEN
|
|
NIdxStatement := ' WITH ':NIdxColumn:' ':Operator:' ':Value
|
|
END ELSE
|
|
NIdxStatement := ' AND WITH ':NIdxColumn:' ':Operator:' ':Value
|
|
END
|
|
ValNo += 1
|
|
REPEAT
|
|
END
|
|
NEXT I
|
|
|
|
RList(IdxStatement, TARGET_ACTIVELIST$, '', '', '' ) ;* This select always runs
|
|
IF Get_Status(errCode) THEN
|
|
ErrMsg(errCode)
|
|
RETURN
|
|
END
|
|
|
|
IF ExportRec<EXPORTS_NQUERY_COL_FILTER$> NE '' THEN
|
|
RList(NIdxStatement, TARGET_ACTIVELIST$, '', '', '' ) ;* This one only runs if there is a non-indexed filter present
|
|
IF Get_Status(errCode) THEN
|
|
RETURN
|
|
END
|
|
END
|
|
|
|
IF NOT(@RECCOUNT) THEN
|
|
MsgInfo = ''
|
|
MsgInfo<MTEXT$> = 'No records meeting your search criteria...'
|
|
MsgInfo<MICON$> = '!'
|
|
RETURN
|
|
END
|
|
|
|
ExpColumns = ExportRec<EXPORTS_COLUMNS$>
|
|
ExpColCnt = COUNT(ExpColumns,@VM) + (ExpColumns NE '')
|
|
|
|
ExpandMV = ExportRec<EXPORTS_EXPAND_MV$>
|
|
|
|
IF ExpandMV THEN
|
|
KeyFields = ''
|
|
FieldNames = DictFields<FIELDS_NAME$>
|
|
|
|
FOR I = 1 TO COUNT(FieldNames,@VM) + (FieldNames NE '')
|
|
IF DictFields<FIELDS_FIELD_NO$,I> = '0' THEN
|
|
IF DictFields<FIELDS_PART$,I> NE '' THEN
|
|
KeyFields<1,DictFields<FIELDS_PART$,I>> = FieldNames<1,I> ;* Build MV's list of key field names
|
|
END ELSE
|
|
Keyfields<1,1> = FieldNames<1,I> ;* Or just the single value
|
|
END
|
|
END
|
|
NEXT I
|
|
|
|
KFCount = COUNT(KeyFields,@VM) + (Keyfields NE '')
|
|
FOR N = KFCount TO 1 Step -1
|
|
KeyField = Keyfields<1,N>
|
|
LOCATE KeyField IN ExpColumns USING @VM SETTING Pos ELSE
|
|
ExpColumns = INSERT(ExpColumns,1,1,0,KeyField) ;* Insert key column not already in the columns list at the front
|
|
END
|
|
NEXT N
|
|
ExpColCnt = COUNT(ExpColumns,@VM) + (ExpColumns NE '')
|
|
END
|
|
|
|
DataOut = ''
|
|
|
|
FOR I = 1 TO ExpColCnt
|
|
ExpColumn = ExpColumns<1,I>
|
|
READV ExpColHeader FROM @DICT,ExpColumn,DICT_DISPLAY$ THEN
|
|
CONVERT @VM TO ' ' IN ExpColHeader ;* Multi-Line headings - convert to flat
|
|
DataOut := QUOTE(ExpColHeader):','
|
|
END
|
|
NEXT I
|
|
|
|
DataOut := CRLF$
|
|
|
|
Def = ""
|
|
Def<MCAPTION$> = "Building Export..."
|
|
Def<MTYPE$ > = "GC"
|
|
Def<MEXTENT$> = @RECCOUNT
|
|
Def<MTEXTWIDTH$> = 400
|
|
|
|
RecCnt = 0
|
|
LineCnt = 1 ;* Headings are on line 1 already
|
|
Done = 0
|
|
LOOP
|
|
READNEXT @ID Else Done = 1
|
|
UNTIL Done
|
|
READ @RECORD FROM TableVar,@ID THEN
|
|
RecCnt += 1
|
|
MaxMVCnt = 0
|
|
LineCnt += 1
|
|
LineOut = ''
|
|
|
|
Continue = TRUE$
|
|
FOR MV = 1 TO 999 WHILE Continue
|
|
Continue = FALSE$
|
|
|
|
FOR N = 1 TO ExpColCnt
|
|
ExpColumn = ExpColumns<1,N>
|
|
LOCATE ExpColumn IN DictFields<FIELDS_NAME$> USING @VM SETTING Pos THEN
|
|
FType = DictFields<FIELDS_TYPE$,Pos>
|
|
FNo = DictFields<FIELDS_FIELD_NO$,Pos>
|
|
FMV = DictFields<FIELDS_MVFLAG$,Pos>
|
|
FPart = DictFields<FIELDS_PART$,Pos>
|
|
FJust = DictFields<FIELDS_JUST$,Pos>
|
|
FConv = DictFields<FIELDS_CONV$,Pos>
|
|
|
|
|
|
IF FNo[1,1] = 0 THEN
|
|
* @ID field
|
|
DataVal = FIELD(@ID,'*',FPart,1)
|
|
END ELSE
|
|
IF FType = 'F' THEN DataVal = @RECORD<FNo>
|
|
IF FType = 'S' THEN
|
|
DataVal = Calculate(ExpColumn)
|
|
END
|
|
END
|
|
|
|
IF FConv NE '' THEN DataVal = OCONV(DataVal,FConv)
|
|
|
|
CONVERT '"' TO ' ' IN DataVal
|
|
|
|
IF ExpandMV AND DataVal<1,MV> = '' AND NOT(FMV) THEN
|
|
DataVal = QUOTE( DataVal<1,1> )
|
|
END ELSE
|
|
DataVal = QUOTE( DataVal<1,MV> )
|
|
END
|
|
|
|
DataOut := DataVal:','
|
|
|
|
IF LEN( DataVal<1,MV+1> ) THEN
|
|
Continue = TRUE$
|
|
END
|
|
|
|
END
|
|
NEXT N
|
|
DataOut := CRLF$
|
|
NEXT MV
|
|
|
|
END
|
|
|
|
rv = 1
|
|
|
|
WHILE rv
|
|
|
|
REPEAT
|
|
|
|
OSWrite DataOut To ExcelFileName
|
|
|
|
xlApp = OleCreateInstance("excel.Application")
|
|
OlePutProperty(XlApp, 'Visible', xlSheetVisible)
|
|
if OleStatus() then Goto HadError
|
|
|
|
|
|
xlWorkBooks = OleGetProperty(xlApp, "Workbooks")
|
|
if OleStatus() then Goto HadError
|
|
|
|
x = OleCallMethod(xlWorkbooks,"OpenText",ExcelFileName)
|
|
if OleStatus() then Goto HadError
|
|
|
|
xlWorkBook = OleGetProperty(xlApp,"ActiveWorkbook")
|
|
if OleStatus() then Goto HadError
|
|
|
|
xlSht = OleGetProperty(xlWorkBook,"ActiveSheet")
|
|
if OleStatus() then Goto HadError
|
|
|
|
xlPageSetup = OleGetProperty(xlSht,"PageSetup")
|
|
if OleStatus() then GOTO HadError
|
|
|
|
OlePutProperty( xlPageSetup, 'PrintGridLines', xlTrue )
|
|
if OleStatus() then GOTO HadError
|
|
|
|
RangeColumn = eXcelCols<1,ExpColCnt>
|
|
range = OleGetProperty( xlSht, 'Range','A1:':RangeColumn:LineCnt)
|
|
|
|
Void = OleCallMethod( range, 'AutoFormat', xlRangeAutoFormatClassic1 )
|
|
IF OleStatus() THEN GOTO HadError
|
|
|
|
TextFileName = ExcelFileName
|
|
SWAP '.csv' WITH '.txt' IN TextFileName
|
|
|
|
Void = OleCallMethod( xlWkb, 'SaveAs',TextFileName, xlWorkbookNormal )
|
|
* No error checking -> xl closes if you don't save otherwise.
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
HadError:
|
|
* * * * * * *
|
|
|
|
a = OleStatus()
|
|
|
|
xlChart = ''
|
|
Charts = ''
|
|
range = ''
|
|
xlSht = ''
|
|
xlWkb=''
|
|
xlWorkBooks = ''
|
|
x = OleCallMethod(xlApp, 'Quit')
|
|
|
|
IF NOT(ASSIGNED(DosTable)) THEN DosTable = ExcelFileName
|
|
|
|
Def = ''
|
|
Def<MTEXT$> = 'File ':DosTable:' written.'
|
|
Def<MTYPE$> = 'TA3'
|
|
|
|
RETURN
|
|
|