Quantcast
Channel: VBForums - Visual Basic 6 and Earlier
Viewing all articles
Browse latest Browse all 21835

bin.exe

$
0
0
hello everybody; i am a newbie to this and the last time i did programming was way back; i really need help and i would greatly appreciate you guys help.

the code below is working; but lets just say if there is an error 76; which is path not found how do i point to that location or also make a probably pop out so that the msgbox can point out to me the location of the error and how to resolve the error.

I greatly appreciate the help being offered. Thank you.



Dim X_Val() As Double
Dim Y_Val() As Double
Dim dSlice() As Double
Dim sLotID As String
Dim sSheetID As String
Dim sDate As String
Dim sRecipe As String
Dim iFileCnt As Long

Dim lDtlRow As Long
Dim RawData() As Variant
Dim Row_Loc As Long

Dim sFlagPath As String
Dim sOutputPath As String
Dim sDataPath As String



Private Sub cdbBrowse_Click()
lblStatus.Caption = ""
lblStatus.Refresh
txtTarget.Text = BrowseForFolder(hWnd, "Please select the folder to Extract Pitch")

File1.Path = txtTarget.Text
File1.Refresh

txtOutput.Text = txtTarget.Text & "\Pitch_Data.xls"
lblStatus.Caption = Str(File1.ListCount) & " Files to process"
lblStatus.Refresh
End Sub



Private Sub cmd_SaveLoc_Click()
txtOutput.Text = BrowseForFolder(hWnd, "Please select the folder to Save OutPut File")
txtOutput.Text = txtOutput.Text & "\Pitch_Data.xls"
End Sub

Private Sub cmdExtract_Click()
Dim i As Integer
Dim j As Integer
Dim lFileno As Long
Dim sInput As String
Dim sLine As String

iFileCnt = 0

lDtlRow = 5

'Read_Recipe

If txtOutput.Text = "" Then
Exit Sub
End If

If Dir(txtOutput.Text) <> "" Then

Else
FileCopy App.Path & "\Template_Bin_Yeild.xls", txtOutput.Text
For i = 1 To 1000
For j = 1 To 2000
lFileno = j / 2.1
Next j
Next i
End If




File1.Pattern = "*.adr"
File1.Path = txtTarget.Text
File1.Refresh

Report_Open txtOutput.Text




For i = 0 To File1.ListCount - 1

Read_ADR_File File1.Path & "\" & File1.List(i)

Next i




With goExcel
.Application.CutCopyMode = False
.Sheets("Data").Select
.ActiveWindow.LargeScroll ToRight:=-1
.ActiveWindow.LargeScroll Down:=-1
.Sheets("Data").Cells(1, 1).Select
End With

goExcel.Application.displayalerts = False 'Šm”FÒ¯¾°¼Þ‚Í•\ަ‚µ‚È‚¢

'•Û‘¶
goExcel.ActiveWorkbook.Save

Call AccelerateEnd

goExcel.ActiveWindow.Close

'ÌßÛ¸Þ×тðI—¹‚µExcel‚ð•‚¶‚é
goExcel.Application.Quit
goExcel.Quit

'µÌÞ¼Þª¸Ä‚̉ð•ú
Set goExcel = Nothing


End Sub

Private Sub Read_ADR_File(ByVal m_sFilepath As String)
Dim lLength As Long
Dim sIniData As String * 255
ReDim RawData(5)
'm_sFilepath = File1.Path & "\" & File1.List(i)
psOutStr = ""
' lLength = GetPrivateProfileString("HEADER", "LOT_ID", "", sIniData, 255, m_sFilepath)
' If lLength < 1 Then
' psOutStr = psOutStr & ""
' Else
' psOutStr = psOutStr & "" & Trim(Left(sIniData, InStr(sIniData, Chr(0)) - 1))
' End If

lLength = GetPrivateProfileString("HEADER", "GLASS_ID", "", sIniData, 255, m_sFilepath)
If lLength < 1 Then
RawData(1) = "-"
Else
RawData(1) = Trim(Left(sIniData, InStr(sIniData, Chr(0)) - 1))
End If

lLength = GetPrivateProfileString("HEADER", "CHIP_NO", "", sIniData, 255, m_sFilepath)
If lLength < 1 Then
RawData(2) = "-"
Else
RawData(2) = Trim(Left(sIniData, InStr(sIniData, Chr(0)) - 1))
End If

lLength = GetPrivateProfileString("HEADER", "CHIP_ID", "", sIniData, 255, m_sFilepath)
If lLength < 1 Then
RawData(3) = "-"
Else
RawData(3) = Trim(Left(sIniData, InStr(sIniData, Chr(0)) - 1))
End If

lLength = GetPrivateProfileString("HEADER", "BIN", "", sIniData, 255, m_sFilepath)
If lLength < 1 Then
RawData(4) = "-"
Else
RawData(4) = Trim(Left(sIniData, InStr(sIniData, Chr(0)) - 1))
RawData(5) = Val(Mid(Trim(Left(sIniData, InStr(sIniData, Chr(0)) - 1)), 2))
End If


With goExcel

'•\ަ
'.Range(.Cells(lDtlRow, 1), .Cells(lDtlRow + mlChipCnt - 1, LIST_COLS)) = mvPasteStr
.Range(.Cells(lDtlRow, 1), .Cells(lDtlRow, UBound(RawData) + 1)) = RawData
lDtlRow = lDtlRow + 1

End With


End Sub

Private Sub Read_Recipe()
Dim i As Integer
Dim lFileno2 As Long
Dim sInput2 As String
Dim sLine2 As String
Dim m_sFilepath As String
Dim sSlice() As String
Dim sSlice2() As String

Dim lLength As Long
Dim sIniData As String * 255
m_sFilepath = App.Path & "\" & App.EXEName & ".ini"

' lFileno2 = FreeFile
'
' Open sFilePath For Input Shared As #lFileno2
'
' Do Until EOF(lFileno2)
' sLine2 = ""
' Line Input #lFileno2, sLine2
' If Trim(UCase(Mid(sLine2, 1, Len(sRecipe)))) = UCase(Trim(sRecipe)) And sRecipe <> "" Then
' sSlice = Split("," & Mid(sLine2, Len(sRecipe) + 2), ",")
' For i = 0 To UBound(sSlice)
' If Trim(sSlice(i)) <> "" Then
' dSlice(i) = CDbl(sSlice(i))
' End If
' Next i
' End If
' Loop
' Close #lFileno2

lLength = GetPrivateProfileString("PRG_INFO", "FLAG_PATH", "", sIniData, 255, m_sFilepath)
If lLength < 1 Then
sFlagPath = ""
MsgBox "INVALID flagpath"
End
Else
sFlagPath = Trim(Left(sIniData, InStr(sIniData, Chr(0)) - 1))
End If

lLength = GetPrivateProfileString("PRG_INFO", "OutputPATH", "", sIniData, 255, m_sFilepath)
If lLength < 1 Then
sOutputPath = ""
MsgBox "INVALID Output path"
End
Else
sOutputPath = Trim(Left(sIniData, InStr(sIniData, Chr(0)) - 1))
End If

lLength = GetPrivateProfileString("PRG_INFO", "DataPATH", "", sIniData, 255, m_sFilepath)
If lLength < 1 Then
sDataPath = ""
MsgBox "INVALID Datapath"
End
Else
sDataPath = Trim(Left(sIniData, InStr(sIniData, Chr(0)) - 1))
End If


End Sub






Private Function Read_File(ByVal sFilePath As String)
ReDim X_Val(100)
ReDim Y_Val(100)

Dim lRet As Long
Dim lFileno As Long
Dim sLineData As String
Dim asTemp() As String
Dim lCnt As Long
Dim iTemp As Integer

sLotID = ""
sSheetID = ""
sDate = ""
sRecipe = ""
For iTemp = 0 To 100
X_Val(iTemp) = 0#
Y_Val(iTemp) = 0#
Next iTemp

lFileno = FreeFile

Open sFilePath For Input Shared As #lFileno

Do Until EOF(lFileno)
Line Input #lFileno, sLineData
If Trim(sLineData) <> "" _
Then
If Len(Trim(sLineData)) > 9 Then
If Mid(sLineData, 1, 4) = "TP_X" Then
X_Val(Int(Mid(sLineData, 6, 2))) = CDbl(Mid(sLineData, 9))
ElseIf Mid(sLineData, 1, 4) = "TP_Y" Then
Y_Val(Int(Mid(sLineData, 6, 2))) = CDbl(Mid(sLineData, 9))
ElseIf Mid(sLineData, 1, 6) = "LOT_ID" Then
sLotID = Trim(Mid(sLineData, 8))
'BOARD_ID
ElseIf Mid(sLineData, 1, 8) = "BOARD_ID" Then
sSheetID = Trim(Mid(sLineData, 10))
'Date
ElseIf Mid(sLineData, 1, 7) = "CL_DATE" Then
sDate = Trim(Mid(sLineData, 9))
'RECIPE
ElseIf Mid(sLineData, 1, 6) = "RECIPE" Then
sRecipe = Trim(Mid(sLineData, 8))
End If
End If
End If
Loop

Close #lFileno

End Function


Public Function Report_Open(ByVal psFileName As String) As Long

On Error GoTo Report_Open_Error
Dim lStartRaw As Long
Call EXCELStartUp

If goExcel Is Nothing _
Then
Exit Function
End If

With goExcel
.Workbooks.Open FileName:=psFileName
.Worksheets("Data").Activate
End With

With goExcel

lStartRaw = .Range(.Cells(1, 1), .Cells(1, 1))
lDtlRow = lStartRaw - 1

'.Range(.Cells(lDtlRow, 1), .Cells(lDtlRow, UBound(RawData) + 1)) = RawData
For lidx = 1 To File1.ListCount
.Rows(lStartRaw & ":" & lStartRaw).Select
.Selection.Copy
.Selection.Insert Shift:=xlDown
Next lidx

.Range(.Cells(1, 1), .Cells(1, 1)) = lStartRaw + File1.ListCount
End With


Exit Function

Report_Open_Error:

'Call gclsMsg.SetSystemInfo("CC999", "Report_Open", Err.Number, Err.Description)
Report_Open = RET_ABEND

End Function

Private Sub Timer1_Timer()
CHECKFLAG
End Sub

Private Sub CHECKFLAG()
Timer1.Enabled = False
Dim sTemp() As String
Dim sTempEnd() As String
Dim iTemp As Integer
Dim sheet_ID As String
Dim sLot_ID As String
Dim strPath As String
Read_Recipe

FILE_FLAG.Pattern = "*GlassEnd.txt"
FILE_FLAG.Path = sFlagPath
FILE_FLAG.Refresh

lblSts.Caption = "Data Processing... "
lblSts.Refresh
If FILE_FLAG.ListCount > 0 Then

'need to call to process

rtbFile.LoadFile FILE_FLAG.Path & "\" & FILE_FLAG.List(0)
sTemp = Split(rtbFile.Text, ",")
sheet_ID = Trim(Mid(FILE_FLAG.List(0), 1, Len(FILE_FLAG.List(0)) - 13))
If sTemp(2) <> "" Then
txtTarget.Text = sDataPath & "\" & sTemp(0) & "\" & sTemp(2) & "\adr\" & sheet_ID
txtTarget.Refresh
txtOutput.Text = sOutputPath & "\" & sTemp(2) & "\" & sTemp(2) & ".xls"
If Dir(sOutputPath & "\" & sTemp(2), vbDirectory) = "" Then
MkDir sOutputPath & "\" & sTemp(2)
End If
txtOutput.Refresh
cmdExtract_Click
strPath = FILE_FLAG.Path & "\" & sheet_ID & "_GlassEnd_p1.txt"
If Dir(strPath) = sheet_ID & "_GlassEnd_p1.txt" Then Kill strPath
Sleep 1000
Name FILE_FLAG.Path & "\" & FILE_FLAG.List(0) As strPath

End If
End If

FILE_FLAG.Pattern = "*LotEnd.txt"
FILE_FLAG.Path = sFlagPath
FILE_FLAG.Refresh

lblSts.Caption = "Lot end File Found... "
lblSts.Refresh
If FILE_FLAG.ListCount > 0 Then
rtbFile.Text = ""
rtbFile.LoadFile FILE_FLAG.Path & "\" & FILE_FLAG.List(0)
sTemp = Split(rtbFile.Text, ",")


File_END.Pattern = "*GlassEnd.txt"
File_END.Path = sFlagPath
File_END.Refresh

If File_END.ListCount > 0 Then
For iTemp = 0 To File_END.ListCount - 1
rtbEND.Text = ""
rtbEND.LoadFile FILE_FLAG.Path & "\" & FILE_FLAG.List(0)
sTempEnd = Split(rtbFile.Text, ",")
If Trim(UCase(sTempEnd(2))) = Trim(UCase(sTemp(2))) Then
Exit Sub
End If
Next iTemp
End If

sLot_ID = sTemp(2)
strPath = FILE_FLAG.Path & "\" & sLot_ID & "_LotEnd_p1.txt"
If Dir(strPath) <> "" Then Kill strPath
Sleep 1000
Name FILE_FLAG.Path & "\" & FILE_FLAG.List(0) As strPath
End If

lblSts.Caption = "Last Processing at " & Now()
lblSts.Refresh
Timer1.Enabled = True
End Sub

Viewing all articles
Browse latest Browse all 21835

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>