Hi Guys, the code below is working; but i need help as i am a newbie and currently working in a programming line which the last time i did programming was donkey years ago.
Ok, spelt out a bit too much sorry, my main concern and main aim for the codes below is that I was wondering if any guys can show me how to point to the location or produce an error message or a notification box to indicate the error:76 that is intermittently popping. because i need to create an error box to show that once an error occurs; how to point to that error location as well as to type a notification on ways to troubleshoot the error.
I greatly appreciate your guys help on this.
Thank you very much for any assistance rendered.
Ok, spelt out a bit too much sorry, my main concern and main aim for the codes below is that I was wondering if any guys can show me how to point to the location or produce an error message or a notification box to indicate the error:76 that is intermittently popping. because i need to create an error box to show that once an error occurs; how to point to that error location as well as to type a notification on ways to troubleshoot the error.
I greatly appreciate your guys help on this.
Thank you very much for any assistance rendered.
Code:
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