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

New Topic/Question
Reply




MultiQuote




|