open-insight/LSL2/STPROC/COMM_INBOUND_COA.txt
Infineon\StieberD 7762b129af pre cutover push
2024-09-04 20:33:41 -07:00

1063 lines
34 KiB
Plaintext

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<COMPANY_CO_NAME$>
IF CompanyRec<COMPANY_DIVISION$> NE '' THEN CompDesc := ' - ':CompanyRec<COMPANY_DIVISION$>:' Division'
IF CompanyRec<COMPANY_CITY$> NE '' THEN CompDesc := ' - ':CompanyRec<COMPANY_CITY$>:', '
IF CompanyRec<COMPANY_STATE$> NE '' THEN CompDesc := CompanyRec<COMPANY_STATE$>
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<CurrRow>
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<CurrRow>
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<COA_LOT_QTY$> = LotQty
CoaRec<COA_LOT_DT$> = LotDt
CoaRec<COA_RX_DTM$> = RxDTM
CoaRec<COA_SPEC$> = CustSpec
CoaRec<COA_PART_NO$> = PartNo
CoaRec<COA_PO_NO$> = CustPO
CoaRec<COA_PARAMETER$> = Parameters
CoaRec<COA_PARM_SPEC$> = ParmSpecs
CoaRec<COA_SAMPLE_SIZE$> = SampleSizes
CoaRec<COA_MIN$> = SampMins
CoaRec<COA_MAX$> = SampMaxs
CoaRec<COA_MEAN$> = SampMeans
CoaRec<COA_STD_DEV$> = StdDevs
CoaRec<COA_SUB_GROWTH_METHOD$> = GrowthMethod
CoaRec<COA_SUB_ORIENTATION$> = Orientation
CoaRec<COA_SUB_COND_TYPE$> = ConductivityType
CoaRec<COA_SUB_DOPANT$> = 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