Trapping error in vb6.0(on error goto Err: not working)

why does the on error statement doesn't trap the error in vb6.0

Page 1 of 1

3 Replies - 9632 Views - Last Post: 10 December 2010 - 01:29 PM Rate Topic: -----

#1 tonchipilato  Icon User is offline

  • New D.I.C Head

Reputation: 0
  • View blog
  • Posts: 3
  • Joined: 28-August 10

Trapping error in vb6.0(on error goto Err: not working)

Posted 03 December 2010 - 10:41 PM

i having an error in my adodb connection using mysql odbc driver, im being disconnected to the server because the serving is timeout or too busy,i want to trap the error to close and open the connection again, to resolve the problem and refresh the connection, but the on error statement doesn't trap the error, please help on this, i used the on error statement many times and it did a great job but on this one i do not know why it is not working,
heres my code:
Dim msg As String

On Error GoTo Err:
 
UpdateAgain:

Record_Type = "Products"

DeleteRecords = False
PassAddproduct = True

Frame5.Caption = "Copying Product Stock Database Record Stage " & Stage & " of " & StageTotal & ""



If Resume_Copy = True Then

ResumeBatchrowset = Startrowset Mod 1000

ResumeBatchrowset = 1000 - Val(ResumeBatchrowset)

    sSql = "SELECT FIRST " & ResumeBatchrowset & " SKIP " & Startrowset & " * FROM STOCK WHERE INACTIVED ='" & "F" & "' AND CATEGORYCODE <> '" & "OWN" & "' AND Stockname <> '" & "F&N CONDENSED MILK 300ML" & "'"
                Set rs = New ADODB.Recordset
                rs.Open sSql, Cn, adOpenStatic
    
    If rs.RecordCount = 0 Then
    Exit Sub
    End If

End If

'If Resume_Copy = False Then
      
      rs.MoveFirst

'End If
            Do While rs.EOF = False
            
            DoEvents
                    
      Stockname = Replace(rs.Fields!Stockname, "'", "''")
      ProductGroup = Replace(rs.Fields!groupcode, "'", "''")
      
                StockCode = rs.Fields!StockCode
                Code = rs.Fields!StockCode
      
            Sql = "Insert into tblproduct (product_code ,product_name ,Category ,product_group ," _
                    & "unit ,unit1 ,unit2 ,unit3, num, num1, num2, num3, " _
                    & "price, price1, price2, price3) Values ('" _
                    & rs.Fields!StockCode & "','" & Stockname & "','" _
                    & rs.Fields!categorycode & "','" & ProductGroup & "','" _
                    & rs.Fields!uom & "','" & rs.Fields!uom1 & "','" & rs.Fields!uom2 & "','" & rs.Fields!uom3 & "' ," _
                    & 1 & ", " & rs.Fields!uom1rate & ", " & rs.Fields!uom2rate & ", " & rs.Fields!uom3rate & ", " _
                    & rs.Fields!listprice & ", " & rs.Fields!uom1unitprice & ", " & rs.Fields!uom2unitprice & ", " & rs.Fields!uom3unitprice & ");"
                              
        
         
            Conn.Execute (Sql)
            ProgressBar1.Value = ProgressBar1.Value + 1
            Label7.Caption = Int(ProgressBar1.Value * 100 / ProgressBar1.Max) & "% Completed"
            Label8.Caption = "Copying: " & Stockname
            
            Label7.Refresh
            Label8.Refresh
            
            
            If Not CopyID = 0 Then
            
            Sql = "DELETE FROM tbluncopy_batch WHERE id = " & CopyID & ""
            MdbConn.Execute (Sql)
            Resume_Copy = False
            CopyID = 0
            
            
            End If
            
  
            
            rs.MoveNext
            
            Totalrecords = Totalrecords + 1
         
            Loop
            
            If Totalrecords = TotalMax Then
            Exit Sub
            End If
            

Call Stock_Update

Exit Sub

Err:


Err.Clear


If Conn.State = adStateOpen Then

Conn.Close


Set Conn = Nothing


Call Connect_Clientdb


 If Not IsWebConnected(msg) Then

 MsgBox "You have been disconnected to the Web Server", vbExclamation + vbOKOnly
 End
 End If
 
'error


Sql = "SELECT * FROM tbluncopy_batch"

Set rs = New ADODB.Recordset
rs.Open Sql, MdbConn, adOpenStatic


If rs.RecordCount = 1 Then

    
                    CopyID = rs.Fields!ID
                    Code = rs.Fields!Code
                    UsedTotalRecords = True
                    Resume_Copy = True
                    Startrowset = rs.Fields!Startrowset
                    Stage = rs.Fields!Stage
                
                    GoTo UpdateAgain

Else

Code = StockCode

Sql = "INSERT INTO tbluncopy_batch(code, record_type, startrowset, stage, status)VALUES ('" & Code & "','" & Record_Type & "', '" _
        & Totalrecords & "','" & Stage & "', '" & "Incomplete" & "')"

MdbConn.Execute (Sql)



    Sql = "SELECT * FROM tbluncopy_batch WHERE record_type = '" & "Products" & "' AND status = '" & "Incomplete" & "'"
    
    Set rs = New ADODB.Recordset
    
    rs.Open Sql, MdbConn, adOpenStatic
  

Trapping error in vb6.0(on error goto Err: not working)



why does the on error statement doesn't trap the error in vb6.0 



  
    If rs.RecordCount = 0 Then
    Exit Sub
    End If


    CopyID = rs.Fields!ID
    Code = rs.Fields!Code
    UsedTotalRecords = True
    Resume_Copy = True
    Startrowset = rs.Fields!Startrowset
    Stage = rs.Fields!Stage
    
    GoTo UpdateAgain
    
End If

End If


hope you can help me on this, is there something wrong with the construction of the code, or what, thank you very much

This post has been edited by macosxnerd101: 03 December 2010 - 10:43 PM
Reason for edit:: Please use code tags


Is This A Good Question/Topic? 0
  • +

Replies To: Trapping error in vb6.0(on error goto Err: not working)

#2 chuckjessup  Icon User is offline

  • D.I.C Regular

Reputation: 34
  • View blog
  • Posts: 380
  • Joined: 26-October 09

Re: Trapping error in vb6.0(on error goto Err: not working)

Posted 09 December 2010 - 11:26 PM

Humm... well Based on what i saw in the code and my honest opinion,(since i am not the most well versed, correct me if i am wrong) what i would do is
... code to here...

exit sub
err:
select case Err.Number
case else:
call dbconnecterr()
end select
end sub


Private Sub dbconnecterr() 'or what ever you called it...'
If Conn.State = adStateOpen Then
Conn.Close
Set Conn = Nothing
Call Connect_Clientdb
If Not IsWebConnected(msg) Then
MsgBox "You have been disconnected to the Web Server", vbExclamation + vbOKOnly
End
End If
Sql = "SELECT * FROM tbluncopy_batch"
Set rs = New ADODB.Recordset
rs.Open Sql, MdbConn, adOpenStatic
If rs.RecordCount = 1 Then
CopyID = rs.Fields!ID
Code = rs.Fields!Code
UsedTotalRecords = True
Resume_Copy = True
Startrowset = rs.Fields!Startrowset
Stage = rs.Fields!Stage
GoTo UpdateAgain
Else
Code = StockCode
Sql = "INSERT INTO tbluncopy_batch(code, record_type, startrowset, stage, status)VALUES ('" & Code & "','" & Record_Type & "', '" _
& Totalrecords & "','" & Stage & "', '" & "Incomplete" & "')"
MdbConn.Execute (Sql)
Sql = "SELECT * FROM tbluncopy_batch WHERE record_type = '" & "Products" & "' AND status = '" & "Incomplete" & "'"
Set rs = New ADODB.Recordset
rs.Open Sql, MdbConn, adOpenStatic
If rs.RecordCount = 0 Then
Exit Sub
End If
CopyID = rs.Fields!ID
Code = rs.Fields!Code
UsedTotalRecords = True
Resume_Copy = True
Startrowset = rs.Fields!Startrowset
Stage = rs.Fields!Stage
GoTo UpdateAgain
End If
End If
End Sub



But that the way i would try to get the thing to work ate leat that would allow me to test the code from there on... just my opinion.

Hope that may give you an idea,

Jesse Fender
Was This Post Helpful? 0
  • +
  • -

#3 guyfromri  Icon User is offline

  • D.I.C Addict

Reputation: 46
  • View blog
  • Posts: 836
  • Joined: 16-September 09

Re: Trapping error in vb6.0(on error goto Err: not working)

Posted 10 December 2010 - 11:31 AM

Err is a built in VBA function. You would use it as If Err.Number=7777 then

Try Changing your line to On Error GoTo Err123

Hope this helps :)
Was This Post Helpful? 1
  • +
  • -

#4 raziel_  Icon User is offline

  • Like a lollipop
  • member icon

Reputation: 469
  • View blog
  • Posts: 4,280
  • Joined: 25-March 09

Re: Trapping error in vb6.0(on error goto Err: not working)

Posted 10 December 2010 - 01:29 PM

yea or to something like err_hndl:
Was This Post Helpful? 0
  • +
  • -

Page 1 of 1