Creating a notification to point to the error
CodeGuru Home VC++ / MFC / C++ .NET / C# Visual Basic VB Forums Developer.com
Results 1 to 2 of 2

Thread: Creating a notification to point to the error

  1. #1
    Join Date
    Jan 2013
    Posts
    1

    Creating a notification to point to the error

    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.
    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
    Last edited by WizBang; January 23rd, 2013 at 12:00 PM. Reason: added [code] tags

  2. #2
    DataMiser is offline Super Moderator Power Poster
    Join Date
    Jul 2008
    Location
    WV
    Posts
    4,851

    Re: Creating a notification to point to the error

    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.
    Always use [code][/code] tags when posting code.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


Windows Mobile Development Center


Click Here to Expand Forum to Full Width

This is a CodeGuru survey question.


Featured


HTML5 Development Center