996 lines
30 KiB
Plaintext
996 lines
30 KiB
Plaintext
COMPILE FUNCTION Comm_Exports(Instruction, Parm1, Parm2, Parm3)
|
|
#pragma precomp SRP_PreCompiler
|
|
|
|
/*
|
|
Commuter module for Exports
|
|
|
|
12/14/2007 - John C. Henry, J.C. Henry & Co., Inc.
|
|
*/
|
|
|
|
DECLARE SUBROUTINE Set_Property, End_Dialog, Send_Event, Set_Status,RList, ErrMsg, Make.List
|
|
DECLARE SUBROUTINE ErrMsg, Send_Message, Set_Property, Send_Event, Btree.Extract, obj_AppWindow
|
|
DECLARE SUBROUTINE Update_Index, SetInitDirOptions, Yield, Security_Err_Msg, Utility, Database_Services
|
|
|
|
DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Utility, Center_Window, Popup, Collect.Ixvals, SRP_DateTime
|
|
DECLARE FUNCTION Send_Message, Security_Check, Message_Box, obj_ICAR, obj_Export, MemberOf, Environment_Services
|
|
DECLARE FUNCTION Datetime, Database_Services
|
|
|
|
$INSERT EXPORTS_EQU
|
|
$INSERT RLIST_EQUATES
|
|
$INSERT MSG_EQUATES
|
|
$INSERT DICT_EQUATES
|
|
$INSERT MESSAGE_BOX_EQUATES
|
|
$INSERT APPCOLORS
|
|
$INSERT SECURITY_RIGHTS_EQU
|
|
$INSERT POPUP_EQUATES
|
|
$INSERT LOGICAL
|
|
$INSERT EXCEL_EQU
|
|
|
|
EQU CRLF$ TO \0D0A\
|
|
|
|
EQU COL$QUERY_COL TO 1
|
|
EQU COL$QUERY_FILTER TO 2
|
|
|
|
|
|
ErrTitle = 'Error in Comm_Exports'
|
|
ErrorMsg = ''
|
|
|
|
Result = ''
|
|
|
|
BEGIN CASE
|
|
CASE Instruction = 'Create' ; GOSUB Create
|
|
CASE Instruction = 'Read' ; GOSUB Read
|
|
CASE Instruction = 'LUExportName' ; GOSUB LUExportName
|
|
CASE Instruction = 'Refresh' ; GOSUB Refresh
|
|
CASE Instruction = 'LUTable' ; GOSUB LUTable
|
|
CASE Instruction = 'LUColumns' ; GOSUB LUColumns
|
|
CASE Instruction = 'ColumnMove' ; GOSUB ColumnMove
|
|
CASE Instruction = 'ClearColumns' ; GOSUB ClearColumns
|
|
CASE Instruction = 'IdxDC' ; GOSUB IdxDC
|
|
CASE Instruction = 'NIdxDC' ; GOSUB NIdxDC
|
|
CASE Instruction = 'PathChange' ; GOSUB PathChange
|
|
CASE Instruction = 'Export' ; GOSUB Export
|
|
|
|
CASE 1
|
|
ErrorMsg = 'Unknown Instruction passed to routine.'
|
|
ErrMsg(ErrorMsg)
|
|
END CASE
|
|
|
|
RETURN Result
|
|
|
|
|
|
* * * * * * *
|
|
Create:
|
|
* * * * * * *
|
|
|
|
obj_Appwindow('Create')
|
|
|
|
TemplatePassed = FIELD( Parm1, '*', 1 )
|
|
SystemGenerated = FALSE$
|
|
|
|
IF INDEX( Parm1, 'NOEXCEL', 1 ) THEN
|
|
Set_Property( @WINDOW, '@NoExcel', 1 )
|
|
END ELSE
|
|
Set_Property( @WINDOW, '@NoExcel', 0 )
|
|
END
|
|
|
|
IF INDEX( Parm1, 'SYSTEM_GENERATED', 1 ) THEN
|
|
SystemGenerated = TRUE$
|
|
END
|
|
|
|
|
|
* This system generated stuff will move to obj_Export as a method JCH
|
|
* These hide the window from the user and just run a predefined export
|
|
|
|
IF SystemGenerated THEN
|
|
Set_Property( @WINDOW, '@SystemGenerated', TRUE$ )
|
|
Set_Property( @WINDOW, '@CurCustomer', FIELD( Parm1, '*', 3 ) )
|
|
TemplateToUse = FIELD( Parm1, '*', 2 )
|
|
|
|
Set_Property(@WINDOW:'.EXPORT_NAME','TEXT', TemplateToUse)
|
|
Send_event( @WINDOW:'.EXPORT_NAME', 'LOSTFOCUS' )
|
|
Send_event( @WINDOW:'.EXPORT_BUTTON', 'CLICK' )
|
|
END
|
|
|
|
IF TemplatePassed THEN
|
|
Set_Property(@WINDOW:'.EXPORT_NAME','TEXT',TemplatePassed)
|
|
Send_event( @WINDOW:'.EXPORT_NAME', 'LOSTFOCUS' )
|
|
END
|
|
|
|
GOSUB Refresh
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
LUExportName:
|
|
* * * * * * *
|
|
|
|
IF NOT(ASSIGNED(Parm1)) THEN FocusControl = '' ELSE FocusControl = Parm1
|
|
IF NOT(ASSIGNED(Parm2)) THEN FocusPos = '' ELSE FocusPos = Parm2
|
|
|
|
RList('SELECT EXPORTS BY NAME WITH SHARABLE = 1 OR WITH ENTRY_ID = ':QUOTE(@USER4), TARGET_ACTIVELIST$, '', '', '' )
|
|
Result = PopUp(@WINDOW,'','SHOW_EXPORTS')
|
|
|
|
IF Result NE '' THEN
|
|
obj_Appwindow('LoadFormKeys',@WINDOW:@RM:Result)
|
|
END
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
Read:
|
|
* * * * * * *
|
|
|
|
ExportID = Get_Property(@WINDOW:'.EXPORT_NAME','TEXT')
|
|
|
|
IF ROWEXISTS( 'EXPORTS', ExportID ) THEN
|
|
|
|
IF Get_Property(@WINDOW:'.SHARABLE','CHECK') NE 1 THEN
|
|
IF @USER4 NE XLATE('EXPORTS',ExportID,EXPORTS_ENTRY_ID$,'X') THEN
|
|
Message = 'You are only allowed to view sharable or your own Export Templates...'
|
|
Message<micon$> = 'H'
|
|
Msg( '', Message )
|
|
Set_Property(@WINDOW,'SAVEWARN',0)
|
|
Send_Event(@WINDOW,'CLEAR')
|
|
RETURN
|
|
END
|
|
END
|
|
|
|
ExportTableName = Get_Property(@WINDOW:'.TABLE','TEXT')
|
|
ExportTableName = OCONV( ExportTableName, '[TABLENAME_CONV]' )
|
|
|
|
IF NOT(Security_Check(ExportTableName,READ$)) THEN
|
|
ErrMsg('You do not have Read rights to the Table used in this export.')
|
|
Set_Property(@WINDOW,'SAVEWARN',0)
|
|
Send_Event(@WINDOW,'CLEAR')
|
|
RETURN
|
|
END
|
|
|
|
END ELSE
|
|
IF Get_Property(@WINDOW:'.ENTRY_ID','TEXT') = '' THEN
|
|
Set_Property(@WINDOW:'.ENTRY_ID','TEXT', OCONV( @USER4, '[XLATE_CONV,LSL_USERS*FIRST_LAST]' ))
|
|
Set_Property(@WINDOW:'.ENTRY_DATE','TEXT',OCONV(Date(),'D4/'))
|
|
END
|
|
END ;* End of check for existing record
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
LUTable:
|
|
* * * * * * *
|
|
|
|
FocusCtrl = Parm1
|
|
IF FocusCtrl = '' THEN
|
|
FocusCtrl = Get_Property(@WINDOW,'@FOCUS')
|
|
END ELSE
|
|
IF NOT(INDEX(FocusCtrl,'.',1)) THEN
|
|
FocusCtrl = @WINDOW:'.':FocusCtrl
|
|
END
|
|
END
|
|
|
|
ExportTableNamesInt = XLATE( 'LISTBOX_CONFIG', 'EXPORTTABLENAMES', 1, 'X' )
|
|
ExportTableNamesExt = OCONV( ExportTableNamesInt, '[TABLENAME_CONV]' )
|
|
|
|
AuthorizedTables = ''
|
|
|
|
TableCnt = COUNT(ExportTableNamesInt,@VM) + (ExportTableNamesInt NE '')
|
|
|
|
LoadCnt = 0
|
|
FOR I = 1 TO TableCnt
|
|
|
|
Table = ExportTableNamesInt<1,I>
|
|
|
|
IF Table EQ 'PM_SCHED' AND MemberOf(@USER4, 'OI_SUPERUSER') THEN Null ;//DEBUG
|
|
IF Table EQ 'ICAR' AND NOT(obj_ICAR('RespSup') ) THEN Null
|
|
|
|
IF Security_Check( ExportTableNamesExt<1,I>, Read$ ) THEN
|
|
LoadCnt += 1
|
|
AuthorizedTables<1,LoadCnt,1> = ExportTableNamesExt<1,I>
|
|
AuthorizedTables<1,LoadCnt,2> = ExportTableNamesInt<1,I>
|
|
END
|
|
|
|
NEXT I
|
|
|
|
IF AuthorizedTables NE '' THEN
|
|
IF MemberOf(@USER4, 'OI_SUPERUSER') THEN
|
|
LoadCnt += 1
|
|
AuthorizedTables<1,LoadCnt,2> = 'NOTES'
|
|
AuthorizedTables<1,LoadCnt+1,2> = 'MODS'
|
|
END
|
|
END
|
|
|
|
|
|
TypeOver = ''
|
|
Typeover<PDISPLAY$> = AuthorizedTables
|
|
|
|
Table = Popup(@WINDOW,TypeOver,'EXPORT_TABLES')
|
|
|
|
errCode = ''
|
|
IF Get_Status(errCode) THEN
|
|
ErrMsg(errCode)
|
|
RETURN
|
|
END
|
|
|
|
IF Table NE '' THEN
|
|
obj_AppWindow('LUValReturn',Table:@RM:FocusCtrl)
|
|
END
|
|
|
|
GOSUB Refresh
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
LUColumns:
|
|
* * * * * * *
|
|
|
|
SelPos = Get_Property(@WINDOW:'.COLUMNS','SELPOS')
|
|
CurrRow = SelPos<2>
|
|
|
|
CurrTable = Get_Property(@WINDOW:'.TABLE','TEXT')
|
|
CurrTableColumns = Get_Property(@WINDOW,'@COLUMNS')
|
|
|
|
PopupData = ''
|
|
FOR I = 1 TO COUNT(CurrTableColumns,@VM) + (CurrTableColumns NE '')
|
|
CurrColumn = CurrTableColumns<1,I>
|
|
PopupData<1,I,1> = CurrColumn
|
|
PopupData<1,I,2> = XLATE('DICT.':CurrTable,CurrColumn,DICT_DESC$,'X')
|
|
NEXT I
|
|
|
|
|
|
TypeOver = ''
|
|
TypeOver<PDISPLAY$> = PopupData
|
|
|
|
SelectedColumns = Popup(@WINDOW,TypeOver,'DICT_COLUMNS')
|
|
|
|
IF SelectedColumns NE '' THEN
|
|
CONVERT @FM TO @VM IN SelectedColumns
|
|
CurrArray = Get_Property(@WINDOW:'.COLUMNS','ARRAY')
|
|
CurrArray = Delete( CurrArray, 1, CurrRow, 0 )
|
|
CurrArray = Insert( CurrArray, 1, CurrRow, 0, SelectedColumns )
|
|
Set_Property(@WINDOW:'.COLUMNS','ARRAY', CurrArray)
|
|
END
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
Refresh:
|
|
* * * * * * *
|
|
|
|
Ctrls = @WINDOW:'.UTIL_START':@RM ; Props = 'VISIBLE':@RM
|
|
Ctrls := @WINDOW:'.UTIL_END':@RM ; Props := 'VISIBLE':@RM
|
|
Ctrls := @WINDOW:'.UTIL_START_LABEL':@RM ; Props := 'VISIBLE':@RM
|
|
Ctrls := @WINDOW:'.UTIL_END_LABEL' ; Props := 'VISIBLE'
|
|
|
|
ExportTableName = Get_Property(@WINDOW:'.TABLE','TEXT')
|
|
|
|
IF ExportTableName = 'REACT_UTIL' THEN
|
|
Vals = '1':@RM:'1':@RM:'1':@RM:'1'
|
|
END ELSE
|
|
Vals = '0':@RM:'0':@RM:'0':@RM:'0'
|
|
END
|
|
|
|
Set_Property(Ctrls,Props,Vals)
|
|
|
|
AllCols = ''
|
|
BtreeCols = ''
|
|
QueryCols = ''
|
|
|
|
IF ExportTableName NE '' THEN
|
|
|
|
DictFields = XLATE('DICT.':ExportTableName,'%FIELDS%','','X')
|
|
|
|
FOR I = 1 TO COUNT(DictFields<FIELDS_NAME$>,@VM) + (DictFields<FIELDS_NAME$> NE '')
|
|
FieldType = DictFields<FIELDS_TYPE$,I>
|
|
FieldName = DictFields<FIELDS_NAME$,I>
|
|
|
|
IF FieldType = 'F' OR FieldType = 'S' THEN
|
|
AllCols<1,-1> = FieldName
|
|
|
|
IF DictFields<FIELDS_INDEX$,I> = 1 THEN
|
|
BtreeCols<1,-1> = FieldName
|
|
END ELSE
|
|
QueryCols<1,-1> = FieldName
|
|
END
|
|
END
|
|
NEXT I
|
|
END
|
|
|
|
Set_Property(@WINDOW,'@COLUMNS',AllCols)
|
|
Set_Property(@WINDOW,'@BTREECOLUMNS',BtreeCols)
|
|
Set_Property(@WINDOW,'@QCOLUMNS',QueryCols)
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
ColumnMove:
|
|
* * * * * * *
|
|
|
|
Direction = Parm1
|
|
|
|
IF Direction = '' THEN RETURN
|
|
|
|
CtrlEntID = @WINDOW:'.COLUMNS'
|
|
|
|
ExpColumns = Get_Property(CtrlEntID,'ARRAY')
|
|
CurrPos = Get_Property(CtrlEntID,'SELPOS')
|
|
CurrRow = CurrPos<2>
|
|
|
|
SWAP @VM:@VM WITH '' IN ExpColumns
|
|
IF ExpColumns[-1,1] = @VM THEN ExpColumns[-1,1] = '' ;* Trims trailing blank lines
|
|
|
|
BEGIN CASE
|
|
CASE Direction = 'UP'
|
|
NewRow = CurrRow - 1
|
|
|
|
CASE Direction = 'DOWN'
|
|
NewRow = CurrRow + 1
|
|
|
|
CASE Direction = 'TOP'
|
|
NewRow = 1
|
|
|
|
CASE Direction = 'BOTTOM'
|
|
NewRow = COUNT(ExpColumns<1>,@VM) + (ExpColumns<1> NE '')
|
|
|
|
END CASE
|
|
|
|
RowData = ExpColumns<1,CurrRow>
|
|
IF RowData <> '' THEN
|
|
ExpColumns = DELETE( ExpColumns, 1, CurrRow, 0 )
|
|
ExpColumns = INSERT( ExpColumns, 1, NewRow, 0, RowData )
|
|
Set_Property(CtrlEntID,'ARRAY',ExpColumns)
|
|
Set_Property(CtrlEntID,'SELPOS',1:@FM:NewRow)
|
|
END
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
ClearColumns:
|
|
* * * * * * *
|
|
|
|
CurrArray = Get_Property(@WINDOW:'.COLUMNS','ARRAY')
|
|
|
|
FOR I = 1 TO COUNT(CurrArray,@VM) + (CurrArray NE '')
|
|
CurrArray<1,I> = ''
|
|
NEXT I
|
|
|
|
Set_Property(@WINDOW:'.COLUMNS','ARRAY', CurrArray)
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
IdxDC:
|
|
* * * * * * *
|
|
|
|
CtrlEntID = @WINDOW:'.QUERY_INFO'
|
|
|
|
CurrPos = Get_Property(CtrlEntID,'SELPOS')
|
|
CurrCol = CurrPos<1>
|
|
CurrRow = CurrPos<2>
|
|
|
|
IF CurrCol = COL$QUERY_COL THEN
|
|
CurrTable = Get_Property(@WINDOW:'.TABLE','TEXT')
|
|
CurrTableColumns = Get_Property(@WINDOW,'@BTREECOLUMNS')
|
|
|
|
PopupData = ''
|
|
FOR I = 1 TO COUNT(CurrTableColumns,@VM) + (CurrTableColumns NE '')
|
|
CurrColumn = CurrTableColumns<1,I>
|
|
PopupData<1,I,1> = CurrColumn
|
|
PopupData<1,I,2> = XLATE('DICT.':CurrTable,CurrColumn,DICT_DESC$,'X')
|
|
NEXT I
|
|
|
|
TypeOver = ''
|
|
TypeOver<PDISPLAY$> = PopupData
|
|
|
|
SelectedColumns = Popup(@WINDOW,TypeOver,'DICT_COLUMNS')
|
|
|
|
IF SelectedColumns NE '' THEN
|
|
|
|
SelColDelimCnt = COUNT(SelectedColumns,@VM)
|
|
|
|
CurrArray = Get_Property(CtrlEntID,'ARRAY')
|
|
CurrArray = INSERT(CurrArray,COL$QUERY_COL, CurrRow, 0, SelectedColumns )
|
|
CurrArray = INSERT(CurrArray,COL$QUERY_FILTER,CurrRow,0,STR(@VM,SelColDelimCnt))
|
|
|
|
Set_Property(CtrlEntID,'ARRAY', CurrArray)
|
|
END
|
|
END
|
|
|
|
IF CurrCol = COL$QUERY_FILTER THEN
|
|
CurrArray = Get_Property(CtrlEntID,'ARRAY')
|
|
|
|
Column = CurrArray<COL$QUERY_COL,CurrRow>
|
|
Filter = CurrArray<COL$QUERY_FILTER,CurrRow>
|
|
|
|
NewFilter = Dialog_Box( 'EXPORTS2', @WINDOW, Column:'*':Filter )
|
|
|
|
IF NewFilter NE Filter And NewFilter NE 'CANCEL' THEN
|
|
CurrArray<COL$QUERY_FILTER,CurrRow> = NewFilter
|
|
Set_Property(CtrlEntID,'ARRAY', CurrArray)
|
|
END
|
|
END
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
NIdxDC:
|
|
* * * * * * *
|
|
|
|
CtrlEntID = @WINDOW:'.NQUERY_INFO'
|
|
|
|
CurrPos = Get_Property(CtrlEntID,'SELPOS')
|
|
CurrCol = CurrPos<1>
|
|
CurrRow = CurrPos<2>
|
|
|
|
IF CurrCol = COL$QUERY_COL THEN
|
|
CurrTable = Get_Property(@WINDOW:'.TABLE','TEXT')
|
|
CurrTableColumns = Get_Property(@WINDOW,'@QCOLUMNS')
|
|
|
|
PopupData = ''
|
|
FOR I = 1 TO COUNT(CurrTableColumns,@VM) + (CurrTableColumns NE '')
|
|
CurrColumn = CurrTableColumns<1,I>
|
|
PopupData<1,I,1> = CurrColumn
|
|
PopupData<1,I,2> = XLATE('DICT.':CurrTable,CurrColumn,DICT_DESC$,'X')
|
|
NEXT I
|
|
|
|
TypeOver = ''
|
|
TypeOver<PDISPLAY$> = PopupData
|
|
|
|
SelectedColumns = Popup(@WINDOW,TypeOver,'DICT_COLUMNS')
|
|
|
|
IF SelectedColumns NE '' THEN
|
|
|
|
SelColDelimCnt = COUNT(SelectedColumns,@VM)
|
|
|
|
CurrArray = Get_Property(CtrlEntID,'ARRAY')
|
|
CurrArray = INSERT(CurrArray,COL$QUERY_COL, CurrRow, 0, SelectedColumns )
|
|
CurrArray = INSERT(CurrArray,COL$QUERY_FILTER,CurrRow,0,STR(@VM,SelColDelimCnt))
|
|
|
|
Set_Property(CtrlEntID,'ARRAY', CurrArray)
|
|
END
|
|
END
|
|
|
|
IF CurrCol = COL$QUERY_FILTER THEN
|
|
CurrArray = Get_Property(CtrlEntID,'ARRAY')
|
|
|
|
Column = CurrArray<COL$QUERY_COL,CurrRow>
|
|
Filter = CurrArray<COL$QUERY_FILTER,CurrRow>
|
|
|
|
NewFilter = Dialog_Box( 'EXPORTS2', @WINDOW, Column:'*':Filter )
|
|
|
|
IF NewFilter NE Filter And NewFilter NE 'CANCEL' THEN
|
|
CurrArray<COL$QUERY_FILTER,CurrRow> = NewFilter
|
|
Set_Property(CtrlEntID,'ARRAY', CurrArray)
|
|
END
|
|
END
|
|
|
|
|
|
* * * * * * *
|
|
PathChange:
|
|
* * * * * * *
|
|
|
|
CtrlEntID = @WINDOW:'.PATH'
|
|
|
|
Path = Get_Property(CtrlEntID,'DEFPROP')
|
|
IF INDEX(Path,'/',1) THEN
|
|
Call ErrMsg('"/" characters are invalid in paths. Use "\" instead.')
|
|
END
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
HadError:
|
|
* * * * * * *
|
|
|
|
status = OleStatus()
|
|
|
|
IF Status THEN
|
|
ErrMsg('OLE Error Code ':Status)
|
|
END
|
|
|
|
xlChart = ''
|
|
Charts = ''
|
|
range = ''
|
|
xlSht = ''
|
|
xlWkb=''
|
|
xlWorkBooks = ''
|
|
x = OleCallMethod(xlApp, 'Quit')
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
CheckError:
|
|
|
|
ErrorCodes = ''
|
|
Status = get_Status( ErrorCodes )
|
|
Parent = ''
|
|
ErrorCode = Get_Property( Parent, 'DDEERROR' )
|
|
|
|
return
|
|
* * * * * * *
|
|
|
|
|
|
* * * * * * *
|
|
Export:
|
|
* * * * * * *
|
|
|
|
* New Version places export data onto the users CLIPBOARD and attempts to start Excel
|
|
* Good Start -> data is pasted into Excel and formatted.
|
|
* Bad Start -> user is told that the data is on the CLIPBOARD of their local machine
|
|
|
|
// Record when it was last run, so we can audit and get the old stuff out of here
|
|
exportRec = Database_Services('ReadDataRow', 'EXPORTS', @ID)
|
|
exportKey = @ID
|
|
exportRec<EXPORTS_LAST_RUN_DATE$> = SRP_DateTime("Combine", DateTime())
|
|
exportRec<EXPORTS_LAST_RUN_USER$> = @USER4
|
|
Database_Services('WriteDataRow', 'EXPORTS', exportKey, exportRec, True$, False$, True$)
|
|
|
|
UtilStartDt = Get_Property(@WINDOW:'.UTIL_START','INVALUE')
|
|
UtilEndDt = Get_Property(@WINDOW:'.UTIL_END','INVALUE')
|
|
SystemGenerated = Get_Property(@WINDOW,'@SystemGenerated')
|
|
NoExcel = Get_Property(@WINDOW,'@NoExcel')
|
|
ExpandMV = Get_Property(@WINDOW:'.EXPAND_MV','CHECK')
|
|
|
|
|
|
Table = Get_Property(@WINDOW:'.TABLE','TEXT')
|
|
|
|
DictTable = 'DICT.':Table
|
|
OPEN Table TO TableVar ELSE
|
|
Msg( '', 'Unable to open ':Table:'...' )
|
|
RETURN
|
|
END
|
|
|
|
OPEN DictTable TO @dict ELSE
|
|
Msg( '', 'Unable to open ':DictTable:'...' )
|
|
RETURN
|
|
END
|
|
|
|
CLEARSELECT
|
|
|
|
Statement = 'SELECT ':Table
|
|
ExportCols = Get_Property(@WINDOW:'.COLUMNS','ARRAY')<1> ;* Export columns
|
|
|
|
SWAP @VM:@VM WITH '' IN ExportCols
|
|
IF ExportCols[-1,1] = @VM THEN ExportCols[-1,1] = ''
|
|
|
|
IdxQuery = Get_Property(@WINDOW:'.QUERY_INFO','ARRAY')
|
|
IdxFilters = IdxQuery<COL$QUERY_FILTER>
|
|
IdxColumns = IdxQuery<COL$QUERY_COL>
|
|
|
|
SWAP @VM:@VM WITH '' IN IdxColumns ; IF IdxColumns[-1,1] = @VM THEN IdxColumns[-1,1] = '' ;* Trim Trailing blanks
|
|
SWAP @VM:@VM WITH '' IN IdxFilters ; IF IdxFilters[-1,1] = @VM THEN IdxFilters[-1,1] = ''
|
|
|
|
IdxColCnt = FieldCount( IdxColumns, @VM )
|
|
ExportColCnt = FieldCount( ExportCols, @VM )
|
|
|
|
* * * Indexed Query * * *
|
|
|
|
ValNo = 1
|
|
FOR I = 1 TO IdxColCnt
|
|
IdxColumn = IdxColumns<1,I>
|
|
IdxFilter = IdxFilters<1,I>
|
|
Operator = FIELD(IdxFilter, ' ', 1 )
|
|
|
|
IF Operator = '<>' THEN Operator = '#'
|
|
IF Operator = 'NE' THEN Operator = '#'
|
|
Values = FIELD(IdxFilter,' ',2,99 )
|
|
ValNo = 1
|
|
|
|
IF TRIM(Operator) = 'FROM' THEN
|
|
SWAP ' TO ' WITH '" TO "' IN Values
|
|
|
|
IF I = 1 THEN
|
|
Statement := ' WITH ':IdxColumn:' ':Operator:' ':QUOTE(Values)
|
|
END ELSE
|
|
Statement := ' AND WITH ':IdxColumn:' ':Operator:' ':QUOTE(Values)
|
|
END
|
|
END ELSE
|
|
|
|
SWAP '~' WITH 'NOT ' IN Operator
|
|
SWAP ' ' WITH '" "' IN Values
|
|
Values = QUOTE(Values)
|
|
|
|
IF I = 1 THEN
|
|
Statement := ' WITH ':IdxColumn:' ':Operator:' ':Values
|
|
END ELSE
|
|
Statement := ' AND WITH ':IdxColumn:' ':Operator:' ':Values
|
|
END
|
|
|
|
END ;* End of check for 'FROM' (Date Range) in filter
|
|
NEXT I
|
|
|
|
|
|
IF Statement NE 'SELECT ':Table THEN
|
|
|
|
DoneSelect = TRUE$
|
|
|
|
Utility( 'CURSOR', 'H' )
|
|
RList( Statement, TARGET_ACTIVELIST$, '', '', '' )
|
|
IF Get_Status(errCode) THEN
|
|
CALL ErrMsg(errCode)
|
|
RETURN
|
|
END
|
|
|
|
END ELSE
|
|
DoneSelect = FALSE$
|
|
END
|
|
|
|
* * * Non Indexed query * * *
|
|
|
|
Statement = 'SELECT ':Table
|
|
|
|
NIdxQuery = Get_Property(@WINDOW:'.NQUERY_INFO','ARRAY')
|
|
NIdxColumns = NIdxQuery<COL$QUERY_COL>
|
|
NIdxFilters = NIdxQuery<COL$QUERY_FILTER>
|
|
|
|
* Trim Trailing blanks
|
|
SWAP @VM:@VM WITH '' IN NIdxColumns ; IF NIdxColumns[-1,1] = @VM THEN NIdxColumns[-1,1] = ''
|
|
SWAP @VM:@VM WITH '' IN NIdxFilters ; IF NIdxFilters[-1,1] = @VM THEN NIdxFilters[-1,1] = ''
|
|
|
|
NIdxColCnt =COUNT(NIdxColumns, @VM ) + (NIdxColumns NE '')
|
|
|
|
|
|
ValNo = 1
|
|
FOR I = 1 TO NIdxColCnt
|
|
NIdxColumn = NIdxColumns<1,I>
|
|
NIdxFilter = NIdxFilters<1,I>
|
|
Operator = FIELD(NIdxFilter, ' ', 1 )
|
|
Values = FIELD(NIdxFilter,' ',2,99 )
|
|
|
|
IF TRIM(Operator) = 'FROM' THEN
|
|
SWAP ' TO ' WITH '" TO "' IN Values
|
|
|
|
IF ValNo = 1 THEN
|
|
Statement := ' WITH ':NIdxColumn:' ':Operator:' ':QUOTE(Values)
|
|
END ELSE
|
|
Statement := ' AND WITH ':NIdxColumn:' ':Operator:' ':QUOTE(Values)
|
|
END
|
|
END ELSE
|
|
|
|
SWAP '~' WITH 'NOT ' IN Operator
|
|
|
|
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
|
|
END
|
|
|
|
Values[1,COL2()] = ''
|
|
|
|
IF ValNo = 1 THEN
|
|
Statement := ' WITH ':NIdxColumn:' ':Operator:' ':Value
|
|
END ELSE
|
|
Statement := ' AND WITH ':NIdxColumn:' ':Operator:' ':Value
|
|
END
|
|
ValNo += 1
|
|
|
|
REPEAT
|
|
END
|
|
NEXT I
|
|
|
|
IF Statement <> 'SELECT ':Table THEN
|
|
Utility( 'CURSOR', 'H' )
|
|
RList( Statement, target_activelist$, '', '', '' )
|
|
END ELSE
|
|
IF DoneSelect = FALSE$ THEN
|
|
MsgInfo = ''
|
|
MsgInfo<mtext$> = 'You have not defined any query information...Do you wish TO export the whole table?'
|
|
MsgInfo<micon$> = '?'
|
|
MsgInfo<mtype$> = 'BNYC'
|
|
IF SystemGenerated THEN
|
|
Resp = 1
|
|
END ELSE
|
|
Resp = Msg( '', MsgInfo )
|
|
END
|
|
IF Resp = 1 THEN
|
|
Utility( 'CURSOR', 'H' )
|
|
RList( Statement, TARGET_ACTIVELIST$, '', '', '' )
|
|
IF Get_Status(errCode) THEN
|
|
CALL ErrMsg(errCode)
|
|
RETURN
|
|
END
|
|
END ELSE
|
|
RETURN
|
|
END
|
|
END
|
|
END
|
|
|
|
ExportColCnt = COUNT(ExportCols,@VM ) + (ExportCols NE '')
|
|
BytePos = 0
|
|
|
|
* Build Qty and List of columns without output conversions
|
|
|
|
TextColCnt = 0
|
|
TextColNos = ''
|
|
|
|
|
|
FOR I = 1 TO ExportColCnt
|
|
OutConversion = XLATE( DictTable, ExportCols<1,I>, DICT_CONV$, 'X' )
|
|
IF OutConversion = '' OR OutConversion[1,2] = 'DT' THEN
|
|
TextColCnt +=1
|
|
TextColNos<1,TextColCnt> = I
|
|
END
|
|
NEXT I
|
|
|
|
PasteOut = ''
|
|
PasteBlob = ''
|
|
TextCols = ''
|
|
|
|
ColNames = ExportCols
|
|
|
|
CONVERT @VM TO @FM IN ColNames
|
|
|
|
ColHeads = XLATE( DictTable, ColNames, DICT_DISPLAY$, 'X' ) ;* Get column headings
|
|
CONVERT @VM TO ' ' IN ColHeads ;* Convert multi-lined headings to single line
|
|
|
|
ExportData = '' ;* Used when writing export data to DOS
|
|
|
|
FOR I = 1 TO ExportColCnt
|
|
PasteOut<1,I> = ColHeads<I>
|
|
ExportData := QUOTE(ColHeads<I>):','
|
|
NEXT I
|
|
|
|
PasteOut := @FM
|
|
|
|
PasteBlob<-1> = PasteOut
|
|
ExportData := CRLF$
|
|
|
|
FieldsRec = XLATE( DictTable, '%FIELDS%', '', 'X' )
|
|
|
|
* setup positions or tag as null
|
|
|
|
FMCs = ''
|
|
KeyParts = ''
|
|
OutConvs = ''
|
|
MVFlags = ''
|
|
|
|
FOR I = 1 TO ExportColCnt
|
|
LOCATE ExportCols<1,I> IN FieldsRec<3> USING @VM SETTING FPos THEN
|
|
FMCs<I> = FieldsRec<FIELDS_FIELD_NO$,FPos>
|
|
KeyParts<I> = FieldsRec<FIELDS_PART$,FPos>
|
|
OutConvs<I> = FieldsRec<FIELDS_CONV$,FPos>
|
|
MVFlags<I> = FieldsRec<FIELDS_MVFLAG$,FPos>
|
|
END ELSE
|
|
MsgInfo = ''
|
|
MsgInfo<mtext$> = 'Unable TO locate ':ExportCols<1,I>:' in %FIELDS%...Get Bryce for Help.'
|
|
MsgInfo<micon$> = '!'
|
|
Void = msg( '', MsgInfo )
|
|
RETURN
|
|
END
|
|
NEXT I
|
|
|
|
|
|
IF ExpandMV THEN
|
|
LOCATE 0 IN FMCs USING @FM SETTING IDPos ELSE
|
|
MsgText = 'You have chosen to expand multi-values, you must select the ID to the table as one '
|
|
MsgText := 'of your export colums, so you know which record each value corresponds to. '
|
|
MsgText := 'Typically this is SEQ.'
|
|
MsgInfo = ''
|
|
MsgInfo<mtext$> = MsgText
|
|
MsgInfo<micon$> = 'H'
|
|
Void = msg( '', MsgInfo )
|
|
RETURN
|
|
END
|
|
END
|
|
|
|
|
|
Def = ""
|
|
Def<MCAPTION$> = "Building Export..."
|
|
Def<MTYPE$ > = "GC"
|
|
Def<MEXTENT$> = @RECCOUNT
|
|
Def<MTEXTWIDTH$> = 400
|
|
|
|
MsgUp = Msg(@WINDOW, Def) ;* Put up the gas gauge
|
|
|
|
@RN.COUNTER = 0
|
|
RecCnt = 0
|
|
Done = 0
|
|
RowCnt = 0
|
|
|
|
|
|
LOOP
|
|
READNEXT @ID ELSE Done = 1
|
|
UNTIL Done
|
|
|
|
READ @RECORD FROM TableVar, @ID ELSE
|
|
GOTO SkipRecord
|
|
END
|
|
|
|
BlobOut = ''
|
|
PasteOut = ''
|
|
Continue = TRUE$
|
|
|
|
FOR MVLine = 1 TO 999 WHILE Continue
|
|
|
|
Continue = FALSE$
|
|
|
|
FOR ExpColNo = 1 TO ExportColCnt
|
|
ThisFmc = FMCs<ExpColNo>
|
|
IsMV = MVFlags<ExpColNo>
|
|
|
|
IF ThisFmc <> '' THEN
|
|
IF ThisFmc = 0 THEN
|
|
|
|
IF KeyParts<ExpColNo> NE '' THEN
|
|
ExDataVal = FIELD(@ID,'*',KeyParts<ExpColNo>)
|
|
END ELSE
|
|
ExDataVal = @ID
|
|
END
|
|
|
|
CONVERT '"' TO '' in ExDataVal
|
|
ThisOutput = OutConvs<ExpColNo>
|
|
|
|
END ELSE
|
|
|
|
ExDataVal = @RECORD<ThisFmc>
|
|
CONVERT '"' TO '' in ExDataVal
|
|
ThisOutput = OutConvs<ExpColNo>
|
|
|
|
END
|
|
END ELSE
|
|
|
|
ExDataVal = CALCULATE( ExportCols<1,ExpColNo> )
|
|
CONVERT '"' TO '' IN ExDataVal
|
|
ThisOutput = OutConvs<ExpColNo>
|
|
|
|
END
|
|
|
|
IF ThisOutput THEN
|
|
IF ExpandMV AND ExDataVal<1,MVLine> = '' AND not(IsMV) THEN
|
|
BlobOut := QUOTE( OCONV(ExDataVal<1,1>, ThisOutput ) ):','
|
|
PasteOut := OCONV(ExDataVal<1,1>,ThisOutput):@VM
|
|
END ELSE
|
|
BlobOut := QUOTE( OCONV(ExDataVal<1,MVLine>, ThisOutput ) ):','
|
|
PasteOut := OCONV(ExDataVal<1,MVLine>,ThisOutput):@VM
|
|
END
|
|
END ELSE
|
|
IF ExpandMV AND ExDataVal<1,MVLine> = '' AND not(IsMV) THEN
|
|
BlobOut := QUOTE(ExDataVal<1,1> ):','
|
|
PasteOut := ExDataVal<1,1>:@VM
|
|
END ELSE
|
|
BlobOut := QUOTE(ExDataVal<1,MVLine> ):','
|
|
PasteOut := ExDataVal<1,MVLine>:@VM
|
|
END
|
|
END
|
|
|
|
|
|
IF LEN(ExDataVal<1,MVLine + 1> ) THEN
|
|
Continue = TRUE$
|
|
|
|
END
|
|
|
|
NEXT ExportColNo
|
|
|
|
IF PasteOut[-1,1] = @VM THEN PasteOut[-1,1] = ''
|
|
PasteOut := @FM
|
|
|
|
BlobOut := CRLF$
|
|
|
|
RowCnt += 1
|
|
|
|
NEXT MVLine
|
|
|
|
ExportData := BlobOut
|
|
|
|
PasteBlob := PasteOut
|
|
|
|
WHILE Msg(@window, MsgUp, @RN.COUNTER, MSGINSTUPDATE$)
|
|
|
|
SkipRecord:
|
|
|
|
REPEAT
|
|
|
|
Msg(@WINDOW, MsgUp) ;* take down the gauge
|
|
|
|
* If text file required -> write BLOB out to the specified DOS filename.
|
|
|
|
DosTable = Get_Property(@WINDOW:'.PATH','TEXT')
|
|
|
|
IF DosTable NE '' THEN
|
|
|
|
IF DosTable[1,1] = 'C' or DosTable[1,1] = 'V' or DosTable[1,1] EQ 'D' ELSE
|
|
MsgText = 'You must export only to your C: drive, or IF you are using terminal server use the '
|
|
MsgText := 'V: drive...Please change the export path to reflect this.'
|
|
MsgInfo = ''
|
|
MsgInfo<mtext$> = MsgText
|
|
MsgInfo<micon$> = '!'
|
|
Msg( '', MsgInfo )
|
|
RETURN
|
|
END
|
|
|
|
DosTable[1,1] = 'C'
|
|
|
|
Status() = 0
|
|
OSWRITE '' ON DosTable
|
|
Tstat = Status()
|
|
|
|
IF Tstat THEN
|
|
Err = 'Bad operating system filename (e1431)'
|
|
Err<-1> = 'Access Denied'
|
|
Err<-1> = 'Disk or Directory full'
|
|
Err<-1> = 'Operating system error not defined elsewhere'
|
|
Err<-1> = 'Attempt to write a read only file'
|
|
Void = msg( '', Err<Tstat> )
|
|
END ELSE
|
|
Status() = 0
|
|
OSWrite ExportData TO DosTable
|
|
|
|
MsgStruct = ''
|
|
MsgStruct<MTYPE$> = 'T2'
|
|
MsgStruct<MCAPTION$> = 'Export Data Written'
|
|
MsgStruct<MTEXT$> = 'Export Data Successfully Written To ':DosTable
|
|
MsgStruct<MICON$> = '*'
|
|
|
|
OK = Msg(@WINDOW,MsgStruct,'')
|
|
END
|
|
END
|
|
|
|
|
|
* * * * * *
|
|
|
|
SWAP @VM WITH CHAR(9) IN PasteBlob
|
|
SWAP @FM WITH CRLF$ IN PasteBlob
|
|
CALL Set_Property('CLIPBOARD', 'TEXT', PasteBlob)
|
|
|
|
* * * Paste it into a blank Excel Sheet
|
|
|
|
xlApp = OleCreateInstance("excel.Application")
|
|
|
|
IF OleStatus() THEN
|
|
ErrorMsg = 'Excel failed to start.':CRLF$:CRLF$
|
|
ErrorMsg := 'The data from this export is on your clipboard and can be pasted into Excel on your local machine using <Ctrl><V> .'
|
|
|
|
ErrMsg(ErrorMsg)
|
|
|
|
END
|
|
|
|
xlWorkBooks = OleGetProperty(xlApp, "Workbooks")
|
|
xlWorkBook = OleCallMethod(xlWorkBooks,'Add')
|
|
|
|
* * * wait a second
|
|
|
|
Now = Time()
|
|
LOOP
|
|
CALL Yield()
|
|
WHILE Time() EQ Now
|
|
REPEAT
|
|
|
|
OlePutProperty(XlApp, 'Visible', xlSheetVisible)
|
|
|
|
void = OleCallMethod(xlWorkBook,'Activate')
|
|
xlActiveSheet = OleGetProperty(xlWorkBook,'ActiveSheet')
|
|
void = OleCallMethod(xlActiveSheet,'Paste')
|
|
|
|
eXcelCols = obj_Export('ExcelCol',TextColNos) ;* Returns alpha Excel columns from numeric columns
|
|
|
|
FirstLastCols = obj_Export('ExcelCol',1:@VM:ExportColCnt)
|
|
|
|
FirstColumn = FirstLastCols[1,@VM]
|
|
LastColumn = FirstLastCols[COL2()+1,@VM]
|
|
|
|
range = OleGetProperty(xlActiveSheet,'Range',FirstColumn:'1:':LastColumn:'1')
|
|
font = OleGetProperty(range,'Font')
|
|
|
|
OlePutProperty(font,'FontStyle','Bold')
|
|
OlePutProperty(font,'UnderLine',xlUnderlineStyleSingle)
|
|
|
|
column = OleGetProperty(xlActiveSheet,'Columns',FirstColumn:':':LastColumn)
|
|
void = OleCallMethod(column,'AutoFit')
|
|
|
|
RETURN
|
|
|
|
|