COMPILE FUNCTION Comm_Inbound_COA(Instruction, Parm1) /* Commuter module for INBOUND_COA dialog window. 002/23/2004 - John C. Henry, J.C. Henry & Co., Inc. */ DECLARE SUBROUTINE Set_Property, End_Dialog, Send_Event, Set_Status, Center_Window DECLARE SUBROUTINE ErrMsg, Send_Message, Btree.Extract, Utility, SetInitDirOptions, OleCallMethod DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Utility, Center_Window, Send_Message, Start_MDIChild DECLARE FUNCTION FieldStore, OleCallMethod EQU CRLF$ TO \0D0A\ EQU LTGREY$ TO 229 + (229*256) + (229*65536) ;* JCH standard colors for edittable backgrounds EQU GREY$ TO 192 + (192*256) + (192*65536) EQU GREEN$ TO 192 + (220*256) + (192*65536) EQU RED$ TO 255 + (128*256) + (128*65536) EQU BLUE$ TO 128 + (255*256) + (255*65536) EQU WHITE$ TO 255 + (255*256) + (255*65536) EQU YELLOW$ TO 255 + (255*256) + (202*65536) EQU LTBLUE$ TO 128 + (255*256) + (255*65536) EQU PURPLE$ TO 225 + (181*256) + (255*65536) EQU vbRdto TO 255 EQU xlSheetVisible TO -1 $INSERT PS_EQUATES $INSERT COMPANY_EQU $INSERT COA $INSERT LOGICAL ErrTitle = 'Error in Comm_Inbound_COA' ErrorMsg = '' Result = '' BEGIN CASE CASE Instruction = 'Create' ; GOSUB Create CASE Instruction = 'Refresh' ; GOSUB Refresh CASE Instruction = 'FolderChg' ; GOSUB FolderChg CASE Instruction = 'ZIPFilesClk' ; GOSUB ZIPFilesClk CASE Instruction = 'Post' ; GOSUB Post CASE 1 ErrorMsg = 'Unknown Instruction passed to routine.' ErrMsg(ErrorMsg) END CASE RETURN Result * * * * * * * Create: * * * * * * * SysSize = get_property( 'SYSTEM', 'SIZE' ) WinSize = get_property( @WINDOW, 'SIZE' ) X = SysSize<1>/2-WinSize<3>/2 Y = SysSize<2>/2-WinSize<4>/2 set_property( @WINDOW, 'SIZE', X:@fm:Y:@fm:WinSize<3>:@fm:WinSize<4> ) ;* Center window in desktop set_property( @WINDOW, 'VISIBLE', 1 ) ;* Make it visible Set_Property(@WINDOW,'STATUSLINE',@WINDOW:'.STATUSLINE') ;* Routes system errors to STATUSLINE control Set_Property(@WINDOW:'.SCRIPTCONTROL','Language','JavaScript') ;* OLE control won't work without this! DefDrive = Drive()[1,'\'] SetInitDirOptions('-R-HD') InitDir DefDrive:"\InboundCofA\*.*" *InitDir DefDrive:"\Apps\InboundCofA\*.*" SubDirectories = DirList() Set_Property(@WINDOW:'.FOLDER','LIST',SubDirectories) GOSUB Refresh RETURN * * * * * * * Refresh: * * * * * * * RETURN * * * * * * * FolderChg: * * * * * * * Folder = Get_Property(@WINDOW:'.FOLDER','TEXT') OPEN 'DICT.COMPANY' TO DictVar THEN Search = 'COA_FOLDER':@VM:Folder:@FM TableName = 'COMPANY' CompanyKeys = '' option = '' flag = '' Set_Status(0) Btree.Extract(Search, TableName, DictVar, CompanyKey, option, flag) IF Get_Status(errCode) THEN ErrMsg(errCode) RETURN END IF CompanyKey = '' THEN ErrorMsg = 'No company on file with COA_FOLDER = ':QUOTE(Folder):'.':@TM ErrorMsg := 'Go to the company window and fill in the COA_FOLDER field ':@TM ErrorMsg := 'with the sub-directory name.' ErrMsg(ErrorMsg) RETURN END IF Index(CompanyKey,@VM,1) THEN SWAP @VM WITH ', ' IN CompanyKey ErrorMsg = 'There is more than one company with COA_FOLDER = ':QUOTE(Folder):@TM ErrorMsg := "The Company No's are ":QUOTE(CompanyKey):". Go to the Company window and ":@TM ErrorMsg := "remove the value ":QUOTE(Folder):" from the COA_FOLDER field ":@TM ErrorMsg := "for one of the companies. Only one company can use a specific subdiretory" ErrMsg(ErrorMsg) RETURN END CompanyRec = XLATE('COMPANY',CompanyKey,'',"X") CompDesc = CompanyRec IF CompanyRec NE '' THEN CompDesc := ' - ':CompanyRec:' Division' IF CompanyRec NE '' THEN CompDesc := ' - ':CompanyRec:', ' IF CompanyRec NE '' THEN CompDesc := CompanyRec Ctrls = @WINDOW:'.COMP_NO':@RM:@WINDOW:'.COMP_NAME' Props = 'TEXT':@RM:'TEXT' Vals = CompanyKey:@RM:CompDesc Set_Property(Ctrls,Props,Vals) DefDrive = Drive()[1,'\'] SetInitDirOptions('-R-H') InitDir DefDrive:"\InboundCofA\":Folder:"\*.XLS" *InitDir DefDrive:"\Apps\InboundCofA\":Folder:"\*.XLS" FolderContents = DirList() Set_Property(@WINDOW:'.ZIP_FILES','LIST',FolderContents) Set_Property(@WINDOW:'.POST_BUTTON','ENABLED',0) END RETURN * * * * * * * ZIPFilesClk: * * * * * * * CtrlName = @WINDOW:'.ZIP_FILES' CurrPos = Get_Property(CtrlName,'SELPOS') CurrRow = CurrPos<2> ZIPList = Get_Property(CtrlName,'LIST') ZIPFile = ZIPList IF ZIPFile NE '' THEN Set_Property(@WINDOW:'.POST_BUTTON','ENABLED',1) END ELSE Set_Property(@WINDOW:'.POST_BUTTON','ENABLED',0) END RETURN * * * * * * * Post: * * * * * * * CompNo = Get_Property(@WINDOW:'.COMP_NO','TEXT') CtrlName = @WINDOW:'.ZIP_FILES' CurrPos = Get_Property(CtrlName,'SELPOS') CurrRow = CurrPos<2> ZIPList = Get_Property(CtrlName,'LIST') ZIPFile = ZIPList DefDrive = Drive() IF ZIPFile NE '' AND ZIPFile[-3,3] = 'zip' THEN Folder = Get_Property(@WINDOW:'.FOLDER','TEXT') DefDrive = Drive()[1,'\'] *DefDrive = Drive()[1,'\']:'\Apps' PathIn = DefDrive:'\InboundCofA\':Folder:'\' ;* Zip Files in here PathOut = DefDrive:'\InboundCofA\Work\' ;* Unzip them into Work subfolder UZCommand = DefDrive:'\WinZip\WZUnzip.exe ':PathIn:ZIPFile:' ':PathOut Utility('RUNWIN',UZCommand,-1) ;* The -1 parm makes the DOS session modal ExitCode = Get_Property(objectname, "EXITCODE") ;* Retrieve OS exit code from WZUnzip process IF ExitCode NE '' THEN debug END END IF ZIPFile NE '' AND ZIPFile[-3,3] = 'xls' THEN Folder = Get_Property(@WINDOW:'.FOLDER','TEXT') DefDrive = Drive()[1,'\'] *DefDrive = Drive()[1,'\']:'\Apps' PathIn = DefDrive:'\InboundCofA\':Folder:'\' ;* Zip Files in here PathOut = DefDrive:'\InboundCofA\Work\' ;* Unzip them into Work subfolder Utility("COPYFILE" , PathIn:ZIPFile, PathOut:ZipFile) END * Wait for the directory information to show up in the OS LoopCnt = 0 LOOP InitDir PathOut:'*.*' xlFileName = DirList()<1> LoopCnt += 1 UNTIL xlFileName NE '' OR LoopCnt > 50000 REPEAT IF LoopCnt > 50000 THEN ErrorMsg = 'InitDir timed out in COMM_INBOUND_COA' RETURN END BEGIN CASE CASE Folder = 'Siltronic' ; GOSUB ExtractSiltronic CASE Folder = 'Okmetic' ; GOSUB ExtractOkmetic CASE Folder = 'Komatsu' ; GOSUB ExtractKomatsu CASE Folder = 'Helitek' ; GOSUB ExtractHelitek CASE 1 ErrMsg('Folder ':QUOTE(Folder):' has no extraction routine. Contact system administrator.') RETURN END CASE RETURN * * * * * * * ExtractSiltronic: * * * * * * * CompNo = '6495' SiltronicNo = xlFileName[1,'_'] err = 0 * Start of New Code *************************** IF ASSIGNED(xlApp) ELSE xlapp = '' xlwkb = '' xlSht = '' Initialized = '' END IF Initialized ELSE xlApp = OleCreateInstance("excel.Application") OlePutProperty(XlApp, 'Visible', True) ; if OleStatus() then Goto HadError OlePutProperty(XlApp, 'WindowState',1) ; if OleStatus() then Goto HadError END xlWorkBooks =OleGetProperty(xlApp, "Workbooks") OleCallMethod(xlWorkbooks, "Open" ,QUOTE(PathOut:xlFileName)) ; if OleStatus() then Goto HadError *xlWorkBooks =OleGetProperty(xlApp, "Workbooks") * New above **************************************** * Samples Below if initialized else xlWorkBooks =OleGetProperty(xlApp, "Workbooks") xlWkb = OleCallMethod(xlWorkbooks,"Add") if OleStatus() then Goto HadError end xlWorkBooks =OleGetProperty(xlApp, "Workbooks") xlWkb = OleCallMethod(xlWorkbooks,"Add") if initialized else xlSht = OleGetProperty(xlWkb, "Worksheets",1) if OleStatus() then Goto HadError end Code = 'Dim Lot' Code<-1> = 'Dim LotQty' Code<-1> = 'Dim LotDt' Code<-1> = 'Dim CustSpec' Code<-1> = 'Dim PartNo' Code<-1> = 'Dim CustPO' Code<-1> = 'Dim GrowthMethod' Code<-1> = 'Dim Orientation' Code<-1> = 'Dim ConductivityType' Code<-1> = 'Dim Dopant' Code<-1> = 'Dim Parameters' Code<-1> = 'Dim ParmSpecs' Code<-1> = 'Dim SampleSizes' Code<-1> = 'Dim SampMins' Code<-1> = 'Dim SampMaxs' Code<-1> = 'Dim SampMeans' Code<-1> = 'Dim StdDevs' Code<-1> = 'Dim UoMs' Code<-1> = 'Dim oCell' Code<-1> = 'Dim myWorksheet' Code<-1> = 'Dim myWorksheets' Code<-1> = 'Dim WorkSheetName' Code<-1> = 'Dim ParmCnt' Code<-1> = 'Dim LastParm' Code<-1> = 'Dim WorksheetNo' Code<-1> = 'Dim CombVals' Code<-1> = 'Dim ChrPos' Code<-1> = 'Dim I' Code<-1> = 'Dim J' Code<-1> = 'Dim TestParm' Code<-1> = 'Result = ""' Code<-1> = 'On Error Resume Next' Code<-1> = 'Set objExcel = CreateObject("excel.Application")' Code<-1> = 'objExcel.WindowState = 1' Code<-1> = 'objExcel.Visible = True' Code<-1> = 'Path = ':QUOTE(PathOut:xlFileName) Code<-1> = 'objExcel.Workbooks.Open Path' Code<-1> = 'objExcel.Sheets("':SiltronicNo:'_H").Select' Code<-1> = 'CustSpec = objExcel.Range("B12").Value' Code<-1> = 'CustPo = objExcel.Range("B14").Value' Code<-1> = 'PartNo = objExcel.Range("B15").Value' Code<-1> = 'LotDt = objExcel.Range("B17").Value' Code<-1> = 'GrowthMethod = objExcel.Range("D12").Value' Code<-1> = 'Orientation = objExcel.Range("D13").Value' Code<-1> = 'CombVals = objExcel.Range("D15").Value' Code<-1> = 'ChrPos = InStr(1,CombVals,"/")' Code<-1> = 'ConductivityType = Left(CombVals,ChrPos)' Code<-1> = 'Dopant = Right(CombVals,Len(CombVals) - ChrPos)' Code<-1> = 'objExcel.Sheets("':SiltronicNo:'_L").Select' Code<-1> = 'For I = 9 To 99 Step 12' ;* Lines of data per lot + 1 for the blank *Code<-1> = 'For I = 9 To 99 Step 10' Code<-1> = ' Parameters = ""' Code<-1> = ' ParmSpecs = ""' Code<-1> = ' SampleSizes = ""' Code<-1> = ' SampMins = ""' Code<-1> = ' SampMaxs = ""' Code<-1> = ' SampMeans = ""' Code<-1> = ' StdDevs = ""' Code<-1> = ' Lot = objExcel.Range("C" & I).Value' Code<-1> = ' LotQty = objExcel.Range("D" & I).Value' Code<-1> = ' TestParm = objExcel.Range("F" & I).Value' Code<-1> = ' If TestParm = "" Then' Code<-1> = ' Exit For' Code<-1> = ' End If' Code<-1> = ' For J = I To I+10' ;* Number of lines of data per lot Code<-1> = ' Parameters = Parameters & objExcel.Range("F" & J).Value & Chr(252)' Code<-1> = ' ParmSpecs = ParmSpecs & objExcel.Range("G" & J).Value & Chr(252)' Code<-1> = ' SampleSizes = SampleSizes & objExcel.Range("J" & J).Value & Chr(252)' Code<-1> = ' SampMeans = SampMeans & objExcel.Range("H" & J).Value & Chr(252)' Code<-1> = ' SampMins = SampMins & objExcel.Range("K" & J).Value & Chr(252)' Code<-1> = ' SampMaxs = SampMaxs & objExcel.Range("L" & J).Value & Chr(252)' Code<-1> = ' StdDevs = StdDevs & objExcel.Range("I" & J).Value & Chr(252)' Code<-1> = ' Next' Code<-1> = ' Result = Result & Lot & Chr(253) & LotQty & Chr(253) & LotDt & Chr(253) & CustSpec & Chr(253)' Code<-1> = ' Result = Result & PartNo & Chr(253) & CustPo & Chr(253) & GrowthMethod & Chr(253)' Code<-1> = ' Result = Result & Orientation & Chr(253) & ConductivityType & Chr(253) & Dopant & Chr(253)' Code<-1> = ' Result = Result & Parameters & Chr(253) & ParmSpecs & Chr(253)' Code<-1> = ' Result = Result & SampleSizes & Chr(253) & SampMins & Chr(253) & SampMaxs & Chr(253)' Code<-1> = ' Result = Result & SampMeans & Chr(253) & StdDevs & Chr(254)' Code<-1> = 'Next' Code<-1> = 'objExcel.ActiveWorkbook.Close' Code<-1> = 'objExcel.Quit' Code<-1> = 'Set objExcel = Nothing' GOSUB RunScript IF strResults NE '' THEN CONVERT @FM TO @RM IN strResults CONVERT @VM TO @FM IN strResults CONVERT @SVM TO @VM IN strResults IF strResults[-1,1] = @RM THEN strResults[-1,1] = '' * Fix up the ParmSpec fields FOR I = 1 TO COUNT(strResults,@RM) + (strResults NE '') strResult = FIELD(strResults,@RM,I) ParmSpecs = strResult<12> FOR N = 1 TO COUNT(ParmSpecs,@VM) ParmSpec = TRIM(ParmSpecs<1,N>) ParmSpec = '>=':ParmSpec Front = ParmSpec[1,' '] Back = FIELD(ParmSpec,' ',2,5) ParmSpec = Front:' <=':Back ParmSpecs<1,N> = ParmSpec NEXT N strResult<12> = ParmSpecs strResults = FieldStore(strResults, @RM, I, 1, strResult) NEXT I GOSUB SaveCofA END RETURN * * * * * * * ExtractOkmetic: * * * * * * * CompanyNo = 683 FileName = xlFileName[1,'.'] Code = 'Dim Lot' Code<-1> = 'Dim LotQty' Code<-1> = 'Dim LotDt' Code<-1> = 'Dim CustSpec' Code<-1> = 'Dim CustPO' Code<-1> = 'Dim GrowthMethod' Code<-1> = 'Dim Orientation' Code<-1> = 'Dim ConductivityType' Code<-1> = 'Dim Dopant' Code<-1> = 'Dim Parameters' Code<-1> = 'Dim ParmSpecs' Code<-1> = 'Dim SampleSizes' Code<-1> = 'Dim SampMins' Code<-1> = 'Dim SampMaxs' Code<-1> = 'Dim SampMeans' Code<-1> = 'Dim StdDevs' Code<-1> = 'Dim UoMs' Code<-1> = 'Dim oCell' Code<-1> = 'Dim myWorksheet' Code<-1> = 'Dim myWorksheets' Code<-1> = 'Dim WorkSheetName' Code<-1> = 'Dim ParmCnt' Code<-1> = 'Dim CharPos' Code<-1> = 'Dim Contents' Code<-1> = 'Dim Character' Code<-1> = 'Dim LastParm' Code<-1> = 'On Error Resume Next' Code<-1> = 'Set objExcel = CreateObject("excel.Application")' Code<-1> = 'objExcel.WindowState = 1' Code<-1> = 'objExcel.Visible = True' Code<-1> = 'objExcel.DisplayAlerts = False' Code<-1> = 'Path = ':QUOTE(PathOut:xlFileName) Code<-1> = 'objExcel.Workbooks.Open Path' Code<-1> = 'Set myWorksheets = objExcel.Worksheets' Code<-1> = 'Result = ""' Code<-1> = 'For Each myWorksheet in myWorksheets' Code<-1> = ' myWorksheet.Activate' Code<-1> = ' WorkSheetName = myWorksheet.Name' *Code<-1> = ' If InStr(WorkSheetName,"Sheet") = "0" Then' Code<-1> = ' CustSpec = myWorkSheet.Range("B2").Value' Code<-1> = ' PartNo = ""' Code<-1> = ' CustPO =""' Code<-1> = ' Lot = myWorksheet.Range("B3").Value' Code<-1> = ' LotQty = myWorksheet.Range("B4").Value' Code<-1> = ' Parameters = ""' Code<-1> = ' ParmCnt = 0' Code<-1> = ' For Each oCell In myWorksheet.Range("A8","A99").Cells' Code<-1> = ' oCell.Activate' Code<-1> = ' If IsEmpty(oCell) Then' Code<-1> = ' Exit For' Code<-1> = ' End If' Code<-1> = ' ParmCnt = ParmCnt + 1' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Clean(oCell.Value)' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Trim(oCell.Value)' Code<-1> = ' CellVal = oCell.Value & Chr(252)' Code<-1> = ' Parameters = Parameters & CellVal' Code<-1> = ' Next' Code<-1> = ' ParmCnt = ParmCnt - 2' Code<-1> = ' LastParm = 9 + ParmCnt' Code<-1> = ' ParmSpecs = Chr(252)' Code<-1> = ' For Each oCell In myWorksheet.Range("B9","B" & LastParm).Cells' Code<-1> = ' oCell.Activate' *Code<-1> = ' Contents = oCell.Value' ;* This tests characters in data result *Code<-1> = ' CellValue = ""' *Code<-1> = ' For CharPos = 1 To Len(Contents)' *Code<-1> = ' Character = Asc(Mid(Contents,CharPos,1))' *Code<-1> = ' CellValue = CellValue & Character & ","' *Code<-1> = ' Next' Code<-1> = ' CellValue = oCell.Value & Chr(252)' Code<-1> = ' ParmSpecs = ParmSpecs & CellValue' Code<-1> = ' Next' Code<-1> = ' SampMeans = Chr(252)' Code<-1> = ' For Each oCell In myWorksheet.Range("C9","C" & LastParm).Cells' Code<-1> = ' oCell.Activate' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Clean(oCell.Value)' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Trim(oCell.Value)' Code<-1> = ' CellValue = oCell.Value & Chr(252)' Code<-1> = ' SampMeans = SampMeans & CellValue' Code<-1> = ' Next' Code<-1> = ' StdDevs = Chr(252)' Code<-1> = ' For Each oCell In myWorksheet.Range("F9","F" & LastParm).Cells' Code<-1> = ' oCell.Activate' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Clean(oCell.Value)' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Trim(oCell.Value)' Code<-1> = ' CellValue = oCell.Value & Chr(252)' Code<-1> = ' StdDevs = StdDevs & CellValue' Code<-1> = ' Next' Code<-1> = ' SampleSizes = Chr(252)' Code<-1> = ' For Each oCell In myWorksheet.Range("G9","G" & LastParm).Cells' Code<-1> = ' oCell.Activate' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Clean(oCell.Value)' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Trim(oCell.Value)' Code<-1> = ' CellValue = oCell.Value & Chr(252)' Code<-1> = ' SampleSizes = SampleSizes & CellValue' Code<-1> = ' Next' Code<-1> = ' SampMins = Chr(252)' Code<-1> = ' For Each oCell In myWorksheet.Range("D9","D" & LastParm).Cells' Code<-1> = ' oCell.Activate' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Clean(oCell.Value)' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Trim(oCell.Value)' Code<-1> = ' CellValue = oCell.Value & Chr(252)' Code<-1> = ' SampMins = SampMins & CellValue' Code<-1> = ' Next' Code<-1> = ' SampMaxs = Chr(252)' Code<-1> = ' For Each oCell In myWorksheet.Range("E9","E" & LastParm).Cells' Code<-1> = ' oCell.Activate' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Clean(oCell.Value)' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Trim(oCell.Value)' Code<-1> = ' CellValue = oCell.Value & Chr(252)' Code<-1> = ' SampMaxs = SampMaxs & CellValue' Code<-1> = ' Next' Code<-1> = ' Result = Result & Lot & Chr(253) & LotQty & Chr(253) & LotDt & Chr(253) & CustSpec & Chr(253)' Code<-1> = ' Result = Result & PartNo & Chr(253) & CustPo & Chr(253) & GrowthMethod & Chr(253)' Code<-1> = ' Result = Result & Orientation & Chr(253) & ConductivityType & Chr(253) & Dopant & Chr(253)' Code<-1> = ' Result = Result & Parameters & Chr(253) & ParmSpecs & Chr(253)' Code<-1> = ' Result = Result & SampleSizes & Chr(253) & SampMins & Chr(253) & SampMaxs & Chr(253)' Code<-1> = ' Result = Result & SampMeans & Chr(253) & StdDevs & Chr(253) & UoMs & Chr(254)' *Code<-1> = ' End If' Code<-1> = 'Next' Code<-1> = 'objExcel.ActiveWorkbook.Close' Code<-1> = 'objExcel.Quit' Code<-1> = 'Set myWorksheets = Nothing' Code<-1> = 'Set objExcel = Nothing' GOSUB RunScript IF strResults NE '' THEN CONVERT @FM TO @RM IN strResults CONVERT @VM TO @FM IN strResults CONVERT @SVM TO @VM IN strResults IF strResults[-1,1] = @RM THEN strResults[-1,1] = '' GOSUB SaveCofA END RETURN * * * * * * * ExtractKomatsu: * * * * * * * CompanyNo = 6624 FileName = xlFileName[1,'.'] Code = 'Dim Lot' Code<-1> = 'Dim LotQty' Code<-1> = 'Dim LotDt' Code<-1> = 'Dim CustSpec' Code<-1> = 'Dim PartNo' Code<-1> = 'Dim CustPO' Code<-1> = 'Dim GrowthMethod' Code<-1> = 'Dim Orientation' Code<-1> = 'Dim ConductivityType' Code<-1> = 'Dim Dopant' Code<-1> = 'Dim Parameters' Code<-1> = 'Dim ParmSpecs' Code<-1> = 'Dim SampleSizes' Code<-1> = 'Dim SampMins' Code<-1> = 'Dim SampMaxs' Code<-1> = 'Dim SampMeans' Code<-1> = 'Dim StdDevs' Code<-1> = 'Dim UoMs' Code<-1> = 'Dim oCell' Code<-1> = 'Dim myWorksheet' Code<-1> = 'Dim myWorksheets' Code<-1> = 'Dim WorkSheetName' Code<-1> = 'Dim ParmCnt' Code<-1> = 'Dim LastParm' Code<-1> = 'Dim WorksheetNo' Code<-1> = 'On Error Resume Next' Code<-1> = 'Set objExcel = CreateObject("excel.Application")' Code<-1> = 'objExcel.WindowState = 1' Code<-1> = 'objExcel.Visible = True' Code<-1> = 'objExcel.DisplayAlerts = False' Code<-1> = 'Path = ':QUOTE(PathOut:xlFileName) Code<-1> = 'objExcel.Workbooks.Open Path' Code<-1> = 'Set myWorksheets = objExcel.Worksheets' Code<-1> = 'Set objExecl.ReferenceStyle = 1' Code<-1> = 'Result = ""' Code<-1> = 'For Each myWorksheet in myWorksheets' Code<-1> = ' myWorksheet.Activate' Code<-1> = ' WorkSheetName = myWorksheet.Name' Code<-1> = ' If WorkSheetName <> ':QUOTE(FileName):' Then' Code<-1> = ' CustSpec = myWorksheet.Range("E5").Value' Code<-1> = ' PartNo = myWorksheet.Range("E4").Value' Code<-1> = ' CustPO = myWorkSheet.Range("E6").Value' Code<-1> = ' Lot = myWorksheet.Range("A5").Value' Code<-1> = ' LotQty = myWorksheet.Range("B5").Value' Code<-1> = ' LotDt = myWorkSheet.Range("C5").Value' Code<-1> = ' GrowthMethod = myWorkSheet.Range("I4").Value' Code<-1> = ' Orientation = myWorkSheet.Range("I5").Value' Code<-1> = ' ConductivityType = myWorkSheet.Range("I6").Value' Code<-1> = ' Dopant = myWorkSheet.Range("I7").Value' Code<-1> = ' Parameters = ""' Code<-1> = ' ParmCnt = 0' Code<-1> = ' For Each oCell In myWorksheet.Range("D11","D99").Cells' Code<-1> = ' oCell.Activate' Code<-1> = ' If IsEmpty(oCell) Then' Code<-1> = ' Exit For' Code<-1> = ' End If' Code<-1> = ' ParmCnt = ParmCnt + 1' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Clean(oCell.Value)' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Trim(oCell.Value)' Code<-1> = ' CellVal = oCell.Value & Chr(252)' Code<-1> = ' Parameters = Parameters & CellVal' Code<-1> = ' Next' Code<-1> = ' ParmCnt = ParmCnt - 1' Code<-1> = ' LastParm = 11 + ParmCnt' Code<-1> = ' UoMs = ""' Code<-1> = ' For Each oCell In myWorksheet.Range("E11","E" & LastParm).Cells' Code<-1> = ' oCell.Activate' Code<-1> = ' CellValue = oCell.Value & Chr(252)' Code<-1> = ' UoMs = UoMs & CellValue' Code<-1> = ' Next' Code<-1> = ' ParmSpecs = ""' Code<-1> = ' For Each oCell In myWorksheet.Range("F11","F" & LastParm).Cells' Code<-1> = ' oCell.Activate' Code<-1> = ' CellValue = oCell.Value & Chr(252)' Code<-1> = ' ParmSpecs = ParmSpecs & CellValue' Code<-1> = ' Next' Code<-1> = ' SampMeans = ""' Code<-1> = ' For Each oCell In myWorksheet.Range("H11","H" & LastParm).Cells' Code<-1> = ' oCell.Activate' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Clean(oCell.Value)' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Trim(oCell.Value)' Code<-1> = ' CellValue = oCell.Value & Chr(252)' Code<-1> = ' SampMeans = SampMeans & CellValue' Code<-1> = ' Next' Code<-1> = ' StdDevs = ""' Code<-1> = ' For Each oCell In myWorksheet.Range("I11","I" & LastParm).Cells' Code<-1> = ' oCell.Activate' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Clean(oCell.Value)' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Trim(oCell.Value)' Code<-1> = ' CellValue = oCell.Value & Chr(252)' Code<-1> = ' StdDevs = StdDevs & CellValue' Code<-1> = ' Next' Code<-1> = ' SampleSizes = ""' Code<-1> = ' For Each oCell In myWorksheet.Range("G11","G" & LastParm).Cells' Code<-1> = ' oCell.Activate' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Clean(oCell.Value)' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Trim(oCell.Value)' Code<-1> = ' CellValue = oCell.Value & Chr(252)' Code<-1> = ' SampleSizes = SampleSizes & CellValue' Code<-1> = ' Next' Code<-1> = ' SampMins = ""' Code<-1> = ' For Each oCell In myWorksheet.Range("J11","J" & LastParm).Cells' Code<-1> = ' oCell.Activate' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Clean(oCell.Value)' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Trim(oCell.Value)' Code<-1> = ' CellValue = oCell.Value & Chr(252)' Code<-1> = ' SampMins = SampMins & CellValue' Code<-1> = ' Next' Code<-1> = ' SampMaxs = ""' Code<-1> = ' For Each oCell In myWorksheet.Range("K11","K" & LastParm).Cells' Code<-1> = ' oCell.Activate' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Clean(oCell.Value)' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Trim(oCell.Value)' Code<-1> = ' CellValue = oCell.Value & Chr(252)' Code<-1> = ' SampMaxs = SampMaxs & CellValue' Code<-1> = ' Next' Code<-1> = ' Result = Result & Lot & Chr(253) & LotQty & Chr(253) & LotDt & Chr(253) & CustSpec & Chr(253)' Code<-1> = ' Result = Result & PartNo & Chr(253) & CustPo & Chr(253) & GrowthMethod & Chr(253)' Code<-1> = ' Result = Result & Orientation & Chr(253) & ConductivityType & Chr(253) & Dopant & Chr(253)' Code<-1> = ' Result = Result & Parameters & Chr(253) & ParmSpecs & Chr(253)' Code<-1> = ' Result = Result & SampleSizes & Chr(253) & SampMins & Chr(253) & SampMaxs & Chr(253)' Code<-1> = ' Result = Result & SampMeans & Chr(253) & StdDevs & Chr(253) & UoMs & Chr(254)' Code<-1> = ' End If' Code<-1> = 'Next' Code<-1> = 'objExcel.ActiveWorkbook.Close' Code<-1> = 'objExcel.Quit' Code<-1> = 'Set objExcel = Nothing' GOSUB RunScript IF strResults NE '' THEN CONVERT @FM TO @RM IN strResults CONVERT @VM TO @FM IN strResults CONVERT @SVM TO @VM IN strResults IF strResults[-1,1] = @RM THEN strResults[-1,1] = '' GOSUB SaveCofA END RETURN * * * * * * * ExtractHelitek: * * * * * * * CompanyNo = 6771 Code = 'Dim Lot' Code<-1> = 'Dim LotQty' Code<-1> = 'Dim LotDt' Code<-1> = 'Dim CustSpec' Code<-1> = 'Dim CustPO' Code<-1> = 'Dim GrowthMethod' Code<-1> = 'Dim Orientation' Code<-1> = 'Dim ConductivityType' Code<-1> = 'Dim Dopant' Code<-1> = 'Dim Parameters' Code<-1> = 'Dim ParmSpecs' Code<-1> = 'Dim SampleSizes' Code<-1> = 'Dim SampMins' Code<-1> = 'Dim SampMaxs' Code<-1> = 'Dim SampMeans' Code<-1> = 'Dim StdDevs' Code<-1> = 'Dim UoMs' Code<-1> = 'Dim oCell' Code<-1> = 'Dim myWorksheet' Code<-1> = 'Dim myWorksheets' Code<-1> = 'Dim WorkSheetName' Code<-1> = 'Dim ParmCnt' Code<-1> = 'Dim CharPos' Code<-1> = 'Dim Contents' Code<-1> = 'Dim Character' Code<-1> = 'Dim LastParm' Code<-1> = 'On Error Resume Next' Code<-1> = 'Set objExcel = CreateObject("excel.Application")' Code<-1> = 'objExcel.WindowState = 1' Code<-1> = 'objExcel.Visible = True' Code<-1> = 'objExcel.DisplayAlerts = False' Code<-1> = 'Path = ':QUOTE(PathOut:xlFileName) Code<-1> = 'objExcel.Workbooks.Open Path' Code<-1> = 'Set myWorksheets = objExcel.Worksheets' Code<-1> = 'Result = ""' Code<-1> = 'For Each myWorksheet in myWorksheets' Code<-1> = ' myWorksheet.Activate' Code<-1> = ' WorkSheetName = myWorksheet.Name' Code<-1> = ' If InStr(WorkSheetName,"COC") = "0" Then' Code<-1> = ' CustSpec = myWorksheet.Range("B7").Value' Code<-1> = ' PartNo = ""' Code<-1> = ' CustPO = myWorkSheet.Range("B8").Value' Code<-1> = ' Lot = myWorksheet.Range("B10").Value' Code<-1> = ' LotQty = myWorksheet.Range("C10").Value' Code<-1> = ' Parameters = ""' Code<-1> = ' ParmCnt = 0' Code<-1> = ' For Each oCell In myWorksheet.Range("A12","A99").Cells' Code<-1> = ' oCell.Activate' Code<-1> = ' If IsEmpty(oCell) Then' Code<-1> = ' Exit For' Code<-1> = ' End If' Code<-1> = ' ParmCnt = ParmCnt + 1' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Clean(oCell.Value)' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Trim(oCell.Value)' Code<-1> = ' CellVal = oCell.Value & Chr(252)' Code<-1> = ' Parameters = Parameters & CellVal' Code<-1> = ' Next' Code<-1> = ' ParmCnt = ParmCnt - 2' Code<-1> = ' LastParm = 13 + ParmCnt' Code<-1> = ' ParmSpecs = Chr(252)' Code<-1> = ' For Each oCell In myWorksheet.Range("B12","B" & LastParm).Cells' Code<-1> = ' oCell.Activate' *Code<-1> = ' Contents = oCell.Value' ;* This tests characters in data result *Code<-1> = ' CellValue = ""' *Code<-1> = ' For CharPos = 1 To Len(Contents)' *Code<-1> = ' Character = Asc(Mid(Contents,CharPos,1))' *Code<-1> = ' CellValue = CellValue & Character & ","' *Code<-1> = ' Next' Code<-1> = ' CellValue = oCell.Value & Chr(252)' Code<-1> = ' ParmSpecs = ParmSpecs & CellValue' Code<-1> = ' Next' Code<-1> = ' SampMeans = Chr(252)' Code<-1> = ' For Each oCell In myWorksheet.Range("C12","C" & LastParm).Cells' Code<-1> = ' oCell.Activate' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Clean(oCell.Value)' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Trim(oCell.Value)' Code<-1> = ' CellValue = oCell.Value & Chr(252)' Code<-1> = ' SampMeans = SampMeans & CellValue' Code<-1> = ' Next' Code<-1> = ' StdDevs = Chr(252)' Code<-1> = ' For Each oCell In myWorksheet.Range("D12","D" & LastParm).Cells' Code<-1> = ' oCell.Activate' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Clean(oCell.Value)' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Trim(oCell.Value)' Code<-1> = ' CellValue = oCell.Value & Chr(252)' Code<-1> = ' StdDevs = StdDevs & CellValue' Code<-1> = ' Next' Code<-1> = ' SampleSizes = Chr(252)' Code<-1> = ' For Each oCell In myWorksheet.Range("E12","E" & LastParm).Cells' Code<-1> = ' oCell.Activate' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Clean(oCell.Value)' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Trim(oCell.Value)' Code<-1> = ' CellValue = oCell.Value & Chr(252)' Code<-1> = ' SampleSizes = SampleSizes & CellValue' Code<-1> = ' Next' Code<-1> = ' SampMins = Chr(252)' Code<-1> = ' For Each oCell In myWorksheet.Range("F12","F" & LastParm).Cells' Code<-1> = ' oCell.Activate' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Clean(oCell.Value)' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Trim(oCell.Value)' Code<-1> = ' CellValue = oCell.Value & Chr(252)' Code<-1> = ' SampMins = SampMins & CellValue' Code<-1> = ' Next' Code<-1> = ' SampMaxs = Chr(252)' Code<-1> = ' For Each oCell In myWorksheet.Range("G12","G" & LastParm).Cells' Code<-1> = ' oCell.Activate' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Clean(oCell.Value)' Code<-1> = ' oCell.Value = objExcel.WorksheetFunction.Trim(oCell.Value)' Code<-1> = ' CellValue = oCell.Value & Chr(252)' Code<-1> = ' SampMaxs = SampMaxs & CellValue' Code<-1> = ' Next' Code<-1> = ' Result = Result & Lot & Chr(253) & LotQty & Chr(253) & LotDt & Chr(253) & CustSpec & Chr(253)' Code<-1> = ' Result = Result & PartNo & Chr(253) & CustPo & Chr(253) & GrowthMethod & Chr(253)' Code<-1> = ' Result = Result & Orientation & Chr(253) & ConductivityType & Chr(253) & Dopant & Chr(253)' Code<-1> = ' Result = Result & Parameters & Chr(253) & ParmSpecs & Chr(253)' Code<-1> = ' Result = Result & SampleSizes & Chr(253) & SampMins & Chr(253) & SampMaxs & Chr(253)' Code<-1> = ' Result = Result & SampMeans & Chr(253) & StdDevs & Chr(253) & UoMs & Chr(254)' Code<-1> = ' End If' Code<-1> = 'Next' Code<-1> = 'objExcel.ActiveWorkbook.Close' Code<-1> = 'objExcel.Quit' Code<-1> = 'Set myWorksheets = Nothing' Code<-1> = 'Set objExcel = Nothing' GOSUB RunScript IF strResults NE '' THEN CONVERT @FM TO @RM IN strResults CONVERT @VM TO @FM IN strResults CONVERT @SVM TO @VM IN strResults IF strResults[-1,1] = @RM THEN strResults[-1,1] = '' GOSUB SaveCofA END RETURN * * * * * * * * * * * * * Local Subroutines * * * * * * * * * * * * * * * * * * * * * * RunScript: * * * * * * * In: Code ;* Windows script * Out: strResult ;* String returned from script hScript = @WINDOW:'.SCRIPTCONTROL' swap @tm with crlf$ in Code swap @fm with crlf$ in Code script = 'function main(argstring)' script := crlf$:'' script := crlf$:'result = 0' script := crlf$:code script := crlf$:'main = result' script := crlf$:'' script := crlf$:'end function' language = 'VbScript' strResults = Send_Message( hScript, 'Reset') Set_Property( hScript ,'Language',language) strResults = Send_Message( hScript, 'AddCode', script ) strResults = Send_Message( hScript, 'Run', "main","" ) RETURN * * * * * * SaveCofA: * * * * * * DeleteXL = 1 *DeleteXL = 0 OPEN 'COA' TO CoaTable THEN FOR I = 1 TO COUNT(strResults,@RM) + (strResults NE '') strResult = FIELD(strResults,@RM,I) LotNo = TRIM(strResult<1>) LotQty = TRIM(strResult<2>) LotDt = ICONV(TRIM(strResult<3>),'D') CustSpec = TRIM(strResult<4>) PartNo = TRIM(strResult<5>) CustPO = TRIM(strResult<6>) GrowthMethod = TRIM(strResult<7>) Orientation = TRIM(strResult<8>) ConductivityType = TRIM(strResult<9>) Dopant = TRIM(strResult<10>) Parameters = TRIM(strResult<11>) ParmSpecs = TRIM(strResult<12>) SampleSizes = TRIM(strResult<13>) SampMins = TRIM(strResult<14>) SampMaxs = TRIM(strResult<15>) SampMeans = TRIM(strResult<16>) StdDevs = TRIM(strResult<17>) Uoms = TRIM(strResult<18>) IF Parameters[-1,1] = @VM THEN Parameters[-1,1] = '' IF ParmSpecs[-1,1] = @VM THEN ParmSpecs[-1,1] = '' IF SampMeans[-1,1] = @VM THEN SampMeans[-1,1] = '' IF StdDevs[-1,1] = @VM THEN StdDevs[-1,1] = '' IF SampleSizes[-1,1] = @VM THEN SampleSizes[-1,1] = '' IF SampMins[-1,1] = @VM THEN SampMins[-1,1] = '' IF SampMaxs[-1,1] = @VM THEN SampMaxs[-1,1] = '' IF Uoms[-1,1] = @VM THEN Uoms[-1,1] = '' CONVERT @VM TO '' IN UomS IF Uoms NE '' THEN FOR J = 1 TO COUNT(ParmSpecs,@VM) + (ParmSpecs NE '') ParmSpecs<1,J> = ParmSpecs<1,J>:' ':strResult<18,J> ;* Append Unit of Measure to specification value NEXT J END IF NOT(Assigned(LotDt)) THEN LotDt = DATE() IF NOT(ASSIGNED(PartNo)) THEN PartNo = '' TMD = TimeDate() RxTime = TMD[1,' '] RxDate = TRIM(TMD[COL2()+1,20]) RxDTM = ICONV(RxDate:' ':RxTime,'DT') CoaKey = CompNo:'*':LotNo CoaRec = '' CoaRec = LotQty CoaRec = LotDt CoaRec = RxDTM CoaRec = CustSpec CoaRec = PartNo CoaRec = CustPO CoaRec = Parameters CoaRec = ParmSpecs CoaRec = SampleSizes CoaRec = SampMins CoaRec = SampMaxs CoaRec = SampMeans CoaRec = StdDevs CoaRec = GrowthMethod CoaRec = Orientation CoaRec = ConductivityType CoaRec = Dopant WRITE CoaRec ON CoaTable,CoaKey ELSE DeleteXL = 0 END ;* End of new OI record write NEXT I END ;* End of COA file open IF DeleteXL THEN BatFile = 'DEL ':PathOut:xlFileName:crlf$ ;* Delete Excel file created from .zip file BatFile := 'DEL ':PathIn:ZIPFile:crlf$ ;* Delete .zip inbound file BatFile := 'EXIT' OSWRITE BatFile ON 'ClearInb.BAT' ;* Write batch file to DOS (Oinsight directory) UTILITY('RUNWIN','ClearInb.BAT') ;* Shell to DOS and execute batch file END GOSUB FolderChg ;* Updates the list of ZIP files. RETURN * * * * * * * HadError: * * * * * * * RETURN