Creating a notification to point to the error

[lainad]

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.

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

[DataMiser]

This question was cross posted and answered on VBForums

Basically the answer is to use an error handler and line numbers then check the ERL value in the error handler and either display or log the info when an error occurs.