11 lines
15 KiB
JSON
11 lines
15 KiB
JSON
{
|
|
"header": {
|
|
"version": 1,
|
|
"type": "record"
|
|
},
|
|
"body": {
|
|
"record1": {
|
|
"<1>": "declare function msg, end_window, fieldcount, get_status, post_event\r\ndeclare subroutine rlist, record_lock\r\n$insert logical\r\n$insert rlist_equates\r\n$insert msg_equates\r\n$insert dict_equates\r\n$insert message_box_equates\r\ndeclare subroutine update_index, SetInitDirOptions, yield\r\ndeclare function message_box\r\nequ CrLf$ to char(13):char(10)\r\n\r\n*CfgFile line one = number of columns\r\n*CfgFile line two = types 1=general 2=text\r\n*CfgFile line three = file to import in excel\r\n*CfgFile line four = number of column heading lines so excel can bold them\r\n*\r\nif ( .util_start->visible = 1 ) then\r\n @user0 = iconv( .util_start->text, 'D' )\r\n @user1 = iconv( .util_end->text, 'D' )\r\nend\r\n*\r\nSystemGenerated = get_property( @window, '@SystemGenerated' )\r\nNoExcel = get_property( @window, '@NoExcel' )\r\nExpandMV = .expand_mv->check\r\nCfgFile = ''\r\nDosTable = .path->text\r\n*if DosTable[1,1] = 'C' or DosTable[1,1] = 'V' else\r\n* MsgInfo = ''\r\n* MsgInfo<mtext$> = 'You must export only to your C: drive, or if you are using terminal server use the V: drive...Please change the export path to reflect this.'\r\n* MsgInfo<micon$> = '!'\r\n* Void = msg( '', MsgInfo )\r\n* return 0\r\n*end\r\n\r\n*IF @USER4 = 'BRYCE_M' THEN\r\n* DEBUG\r\n*END\r\nOSOpen 'V:\\AUTOEXEC.BAT' To TPathHandle then\r\n OSClose TPathHandle\r\n DriveToUse = 'V:'\r\n DosTable[1,1] = 'V'\r\nend else\r\n DriveToUse = 'C:'\r\nend\r\nCfgFile<2> = DosTable\r\n\r\nTable = .exporttablenames->text\r\nDictTable = 'DICT.':Table\r\nopen Table to TableVar else\r\n Void = msg( '', 'Unable to open ':Table:'...' )\r\n return 0\r\nend\r\nopen DictTable to @dict else\r\n Void = msg( '', 'Unable to open ':DictTable:'...' )\r\n return 0\r\nend\r\nstatus() = 0\r\noswrite '' on DosTable\r\nTstat = status()\r\nif Tstat then\r\n Err = 'Bad operating system filename'\r\n Err<-1> = 'Access Denied'\r\n Err<-1> = 'Disk or Directory full'\r\n Err<-1> = 'Operating system error not defined elsewhere'\r\n Err<-1> = 'Attempt to write a read only file'\r\n Void = msg( '', Err<Tstat> )\r\n return 0\r\nend\r\nosopen DosTable to DosTableVar else\r\n Err = 'Bad operating system filename'\r\n Err<-1> = 'Access Denied'\r\n Err<-1> = 'File does not exist'\r\n Err<-1> = 'Undefined error'\r\n Void = msg( '', Err<status()> )\r\n return 0\r\nend\r\n\r\nclearselect\r\nStatement = 'SELECT ':Table\r\nColumns = .export_info->array<1>\r\nswap @vm:@vm with '' in Columns\r\nif Columns[-1,1] = @vm then Columns[-1,1] = ''\r\nBColumns = .query_info->array\r\nBColumnsQ = BColumns<2>\r\nBColumns = BColumns<1>\r\nswap @vm:@vm with '' in BColumns\r\nif BColumns[-1,1] = @vm then BColumns[-1,1] = ''\r\nswap @vm:@vm with '' in BColumnsQ\r\nif BColumnsQ[-1,1] = @vm then BColumnsQ[-1,1] = ''\r\nBcnt = fieldcount( BColumns, @vm )\r\nCcnt = fieldcount( Columns, @vm )\r\nCfgFile<1> = Ccnt\r\nif Bcnt then\r\n\tfor i = 1 to Bcnt\r\n\t CompVal = BColumnsQ<1,i>\r\n\t Op = field( CompVal, ' ', 1 )\r\n\t swap '~' with 'NOT ' in Op\r\n\t Rest = field( CompVal, ' ', 2, 999 )\r\n\t swap ' ' with '\" \"' in Rest\r\n\t Rest = '\"':Rest:'\"'\r\n\t if CompVal <> '' then\r\n\t if i = 1 then\r\n\t Statement := ' WITH ' \r\n\t end else\r\n\t Statement := ' AND WITH '\r\n\t end\r\n\t Statement := BColumns<1,i>:' ':Op:' ':Rest\r\n\t end\r\n\tnext i\r\nend\r\n\r\nif Statement <> 'SELECT ':Table then\r\n * btree column selection\r\n DoneSelect = true$\r\n *IF @USER4 = 'BRYCE_M' THEN\r\n * DEBUG\r\n *END\r\n SWAP '\"TO\"' WITH 'TO' IN STATEMENT\r\n * ABOVE LINE OF CODE IS SO YOU CAN DO A RANGE ON ONE LINE\r\n * I.E. DATE_OUT FROM 8/1/97 TO 8/5/97 IT REMOVES THE QUOTES\r\n * IT WILL THEN USE THE INDEXES\r\n Void = utility( 'CURSOR', 'H' ) \r\n rlist( Statement, target_activelist$, '', '', '' )\r\nend else\r\n DoneSelect = false$\r\nend\r\n*\r\nStatement = 'SELECT ':Table\r\nNColumns = .nquery_info->array\r\nNColumnsQ = NColumns<2>\r\nNColumns = NColumns<1>\r\nswap @vm:@vm with '' in NColumns\r\nif NColumns[-1,1] = @vm then NColumns[-1,1] = ''\r\nswap @vm:@vm with '' in NColumnsQ\r\nif NColumnsQ[-1,1] = @vm then NColumnsQ[-1,1] = ''\r\nNcnt = fieldcount( NColumns, @vm )\r\nif Ncnt then\r\n\tfor i = 1 to Ncnt\r\n\t CompVal = NColumnsQ<1,i>\r\n\t Op = field( CompVal, ' ', 1 )\r\n\t swap '~' with 'NOT ' in Op\r\n\t Rest = field( CompVal, ' ', 2, 999 )\r\n\t swap ' ' with '\" \"' in Rest\r\n\t Rest = '\"':Rest:'\"'\r\n\t if CompVal <> '' then\r\n\t if i = 1 then\r\n\t Statement := ' WITH ' \r\n\t end else\r\n\t Statement := ' AND WITH '\r\n\t end\r\n\t Statement := NColumns<1,i>:' ':Op:' ':Rest\r\n\t end\r\n\tnext i\r\nend\r\nif Statement <> 'SELECT ':Table then\r\n Void = utility( 'CURSOR', 'H' )\r\n SWAP '\"TO\"' WITH 'TO' IN STATEMENT\r\n rlist( Statement, target_activelist$, '', '', '' ) \r\nend else\r\n if DoneSelect = false$ then\r\n\t MsgInfo = ''\r\n\t MsgInfo<mtext$> = 'You have not defined any query information...Do you wish to export the whole table?'\r\n\t MsgInfo<micon$> = '?'\r\n\t MsgInfo<mtype$> = 'BNYC'\r\n\t if SystemGenerated then\r\n\t Resp = 1\r\n\t end else\r\n\t Resp = msg( '', MsgInfo )\r\n\t end\r\n\t if Resp = 1 then\r\n \t Void = utility( 'CURSOR', 'H' )\r\n \t rlist( Statement, target_activelist$, '', '', '' ) \r\n\t end else\r\n\t return 0\r\n\t end\r\n end\r\nend\r\n\r\nif @reccount then\r\n Ccnt = fieldcount( Columns, @vm )\r\n\tBytePos = 0\r\n * set headings\r\n TColumns = Columns\r\n convert @vm to @fm in TColumns\r\n Headings = xlate( DictTable, TColumns, dict_display$, 'X' )\r\n CONVERT @VM TO ' ' IN HEADINGS\r\n * CAUSE IT WOULD CAUSE A SECOND HEADING LINE \r\n * SO THIS CODE IS IRRELEVANT ON PARSING MULTI LINE HEADINGS\r\n Continue = True$\r\n BlobOut = ''\r\n for i = 1 to 999 while Continue\r\n\t Continue = false$\r\n for j = 1 to Ccnt\r\n Thead = Headings<j,i>\r\n BlobOut := Quote( Headings<j,i> ):\",\"\r\n if len( Headings<j,i+1> ) then\r\n Continue = true$\r\n end\r\n\t next j\r\n\t BlobOut := CrLf$\r\n next i\r\n * END OF IRRELEVANT CODE\r\n CfgFile<3> = i-1\r\n TextCnt = 0\r\n TextCfgOut = ''\r\n for i = 1 to Ccnt\r\n Output = xlate( DictTable, Columns<1,i>, dict_conv$, 'X' )\r\n if Output else\r\n TextCnt +=1\r\n TextCfgOut := i:@fm\r\n end\r\n next i\r\n swap @fm with CrLf$ in TextCfgOut\r\n CfgFile<4> = TextCnt\r\n CfgFile<5> = TextCfgOut\r\n osbwrite BlobOut on DosTableVar AT BytePos\r\n\tBytePos += len( BlobOut )\t \r\n\tTstat = status()\r\n\tif Tstat then\r\n\t Err = 'Bad operating system filename'\r\n\t Err<-1> = 'Access Denied'\r\n\t Err<-1> = 'Disk or directory full'\r\n\t Err<-1> = 'File does not exist'\r\n\t Err<-1> = 'Undefined error'\r\n\t Err<-1> = 'Attempt to write a read only file'\r\n\t Err<-1> = 'Invalid beginning byte position'\r\n\t Void = msg( '', Err<Tstat> )\r\n\t return 0\r\n\tend\r\n FieldsRec = xlate( DictTable, '%FIELDS%', '', 'X' )\r\n * setup positions or tag as null\r\n Fmcs = ''\r\n Outputs = ''\r\n MultiValue = ''\r\n for i = 1 to Ccnt\r\n locate Columns<1,i> in FieldsRec<3> using @vm setting Fpos then\r\n Fmcs<i> = FieldsRec<5,Fpos>\r\n Outputs<i> = FieldsRec<12,Fpos>\r\n MultiValue<i> = FieldsRec<9,FPos>\r\n end else\r\n MsgInfo = ''\r\n MsgInfo<mtext$> = 'Unable to locate ':Columns<1,i>:' in %FIELDS%...Get Bryce for Help.'\r\n MsgInfo<micon$> = '!'\r\n Void = msg( '', MsgInfo )\r\n return 0\r\n end\r\n next i\r\n if ExpandMV then\r\n\t locate 0 in Fmcs using @fm setting IDPos else\r\n\t MsgInfo = ''\r\n\t MsgInfo<mtext$> = 'You have choosen to expand multi-values, you must select the ID to the table as one of your export colums, so you know which record each value corresponds to. Typically this is SEQ.'\r\n\t MsgInfo<micon$> = 'H'\r\n\t Void = msg( '', MsgInfo )\r\n\t return 0\r\n\t end\r\n end\r\n .percent_complete->visible = 1\r\n .gasbarbox->visible = 1\r\n CurrentSize = .gasbar->size\r\n NewSize = CurrentSize\r\n NewSize<3> = 0\r\n .gasbar->size = NewSize\r\n .gasbar->visible = 1\r\n\t@rn.counter = 0\r\n\tEof = false$\r\n\tOnePercent = iconv( @reccount*.01, 'MD0' )\r\n\tloop\r\n\t readnext @id else Eof = true$\r\n\tuntil Eof\r\n\t read @record from TableVar, @id else\r\n\t Void = msg( '', 'Unable to read ':@id:' from ':Table )\r\n\t return 0\r\n\t end\r\n\t BlobOut = ''\r\n\t Continue = true$\r\n\t for i = 1 to 999 while Continue\r\n\t Continue = false$\r\n for j = 1 to Ccnt\r\n ThisFmc = Fmcs<j>\r\n IsMV = MultiValue<j>\r\n if ThisFmc <> '' then\r\n if ThisFmc = 0 then\r\n TCol = @id\r\n if ExpandMV and TCol<1,i> = '' and not(IsMV) then\r\n BlobOut := quote( TCol<1,1> ):',' \r\n end else\r\n BlobOut := quote( TCol<1,i> ):','\r\n end\r\n end else\r\n TCol = @record<ThisFmc>\r\n convert '\"' to '' in TCol\r\n ThisOutput = Outputs<j>\r\n if ThisOutput then\r\n if ExpandMV and TCol<1,i> = '' and not(IsMV) then\r\n BlobOut := quote( oconv( TCol<1,1>, ThisOutput ) ):',' \r\n end else\r\n BlobOut := quote( oconv( TCol<1,i>, ThisOutput ) ):','\r\n end\r\n end else\r\n if ExpandMV and TCol<1,i> = '' and not(IsMV) then\r\n BlobOut := quote( TCol<1,1> ):',' \r\n end else\r\n BlobOut := quote( TCol<1,i> ):','\r\n end\r\n end\r\n if len( Tcol<1,i+1> ) then\r\n Continue = true$\r\n end\r\n end\r\n end else\r\n * calculate\r\n TCol = calculate( Columns<1,j> )\r\n convert '\"' to '' in TCol\r\n ThisOutput = Outputs<j>\r\n if ThisOutput then\r\n if ExpandMV and TCol<1,i> = '' and not(IsMV) then\r\n BlobOut := quote( oconv( TCol<1,1>, ThisOutput ) ):',' \r\n end else\r\n BlobOut := quote( oconv( TCol<1,i>, ThisOutput ) ):','\r\n end\r\n end else\r\n if ExpandMV and TCol<1,i> = '' and not(IsMV) then\r\n BlobOut := quote( TCol<1,1> ):',' \r\n end else\r\n BlobOut := quote( TCol<1,i> ):','\r\n end\r\n end\r\n if len( Tcol<1,i+1> ) then\r\n Continue = true$\r\n end\r\n end \r\n\t next j\r\n\t BlobOut := CrLf$\r\n\t next i\r\n\t osbwrite BlobOut on DosTableVar AT BytePos\r\n\t BytePos += len( BlobOut )\t \r\n\t Tstat = status()\r\n\t if Tstat then\r\n\t Err = 'Bad operating system filename'\r\n\t Err<-1> = 'Access Denied'\r\n\t Err<-1> = 'Disk or directory full'\r\n\t Err<-1> = 'File does not exist'\r\n\t Err<-1> = 'Undefined error'\r\n\t Err<-1> = 'Attempt to write a read only file'\r\n\t Err<-1> = 'Invalid beginning byte position'\r\n\t Void = msg( '', Err<Tstat> )\r\n\t return 0\r\n\t end\r\n if mod( @rn.counter, OnePercent ) else\r\n\t \t NewWidth = CurrentSize<3> * @rn.counter/@reccount\r\n\t\t .percent_complete->text = oconv(iconv( @rn.counter/@reccount*100, 'MD0' ), 'MD0' ):'%'\r\n\t\t NewSize<3> = NewWidth\r\n\t\t .gasbar->redraw = 0\r\n\t\t .gasbar->size = NewSize\r\n\t .gasbar->redraw = 1\r\n\t end\r\n\trepeat\r\n if @rn.counter > 0 and @reccount > 0 then\r\n\t NewWidth = CurrentSize<3> * @rn.counter/@reccount\r\n\t .percent_complete->text = oconv(iconv( @rn.counter/@reccount*100, 'MD0' ), 'MD0' ):'%'\r\n\t NewSize<3> = NewWidth\r\n\t .gasbar->redraw = 0\r\n\t .gasbar->size = NewSize\r\n\t .gasbar->redraw = 1\r\n end\r\n .percent_complete->visible = 0\r\n .gasbarbox->visible = 0\r\n swap @fm with CrLf$ in CfgFile\r\n CfgFile := CrLf$\r\n oswrite CfgFile on DriveToUse:'\\IMP.CFG' \r\n if status() then\r\n Void = msg( '', 'Error creating Excel import config file.' )\r\n return 0\r\n end\r\n osclose DosTableVar\r\n\r\n\tSetInitDirOptions(\"D\")\r\n\tList = ''\r\n\tOfficePath = DriveToUse:'\\Program Files\\Microsoft Office\\Office'\r\n\tinitdir OfficePath\r\n\tList = DirList()\r\n\t\t\r\n\tIF List = '' THEN\r\n\t\tfor i = 1 to 15\r\n\t\t\tOfficePath = DriveToUse:'\\Program Files\\Microsoft Office\\Office':I\r\n\t\t\tinitdir OfficePath\r\n\t\t\tlist = DirList()\r\n\t\tuntil list <> ''\r\n\t\tnext i\r\n\tEND\r\n \r\n\r\n if SystemGenerated and not( NoExcel ) then\r\n\t\tTCust = get_property( @window, '@CurCustomer' ) \r\n \tMsgText = ''\r\n \tMsgText:= CrLf$:'1) Check the data'\r\n \tMsgText:= CrLf$:'2) Save the spreadsheet As \"Microsoft Excel 97-2000 & 5.0/95 Workbook.\"'\r\n \tMsgText:= CrLf$:'3) Name the spreadsheet starting with CustomerName and then n...for the shipment number of the day.'\r\n \tMsgText:= CrLf$:'4) Launch Lotus Notes and Email this spreadsheet to ':TCust:'.'\r\n \tVoid = message_box( '', MsgText, 'Email Reminder!', MSG_ICON_INFO$ + MSG_BTN_OK$ ) \r\n \t*Void = post_event( @window, 'CLOSE' )\r\n end\r\nend else\r\n MsgInfo = ''\r\n MsgInfo<mtext$> = 'No records meeting your search criteria...'\r\n MsgInfo<micon$> = '!'\r\n Void = msg( '', MsgInfo )\r\nend\r\nVoid = utility( 'CURSOR', 'A' )\r\n@user0 = ''\r\n@user1 = ''\r\nreturn 0\r\n\r\n*===========================================================================*\r\nCheckError:\r\n Status = get_status( ErrorCodes )\r\n ErrorCode = get_property( Parent, 'DDEERROR' )\r\n* DEBUG\r\nreturn\r\n\r\n*===========================================================================*\r\n\r\n"
|
|
}
|
|
}
|
|
} |