VB6 Recordset update - vb6

Question

I am running a vb6 program that is looping through many records in a database table and entering a date into a field. This will take many hours to run.
I am noticing that the number of records in the table is increasing by 1 every few seconds and then reducing by 1 (going back to the original count). Is there a reason for this?
I am using a VB6 recordset and the update function i.e. rs.update. I am not inserting any new records.
The code is as follows:
rs.Open "select reference,value1,datefield from datetable where field1 = 'value1' " & _
"order by reference", objAuditCon.ActiveCon, adOpenStatic, adLockPessimistic
Do While Not rs.EOF
intReadCount = intReadCount + 1
DoEvents
If Not IsNull(rs("value1")) Then
testArray = Split(rs("value1"), ",")
rs2.Open "SELECT Date FROM TBL_TestTable WHERE Record_URN = '" & testArray(1) & "'", objSystemCon.ActiveCon, adOpenStatic, adLockReadOnly
If rs2.EOF Then
End If
If Not rs2.EOF Then
rs("DateField") = Format$(rs2("Date"), "dd mmm yy h:mm:ss")
rs.Update
intWriteCount = intWriteCount + 1
End If
rs2.Close
Else
End If
rs.MoveNext
Loop
rs.Close

Answer 1

Well you can greatly reduce your SQL work here.
If Not IsNull(rs("value1")) Then
testArray = Split(rs("value1"), ",")
rs2.Open "SELECT Date FROM TBL_TestTable WHERE Record_URN = '" & testArray(1) & "'", objSystemCon.ActiveCon, adOpenStatic, adLockReadOnly
If rs2.EOF Then
End If
If Not rs2.EOF Then
rs("DateField") = Format$(rs2("Date"), "dd mmm yy h:mm:ss")
rs.Update
intWriteCount = intWriteCount + 1
End If
rs2.Close
You're essentially, it looks to me(I haven't used VB6 & ADO in 10 years), loading up your record initial recordset, checking a value, and if that value is not null running a second select THEN updating the recordset....
You can instead of doing all this just create a command object
Declare these before your loops
dim objComm
set objComm = Server.CreateObject("ADODB.Command")
objComm.ActiveConnection = objSystemCon.ActiveCon 'I think this is your connn.
objComm.CommandType = 1 'adCmdText
Use this in your loop
objComm.CommandText = "UPDATE DateTable SET DateField = (SELECT Date FROM TBL_TestTable WHERE Record_URN = '" & testArray(1) & "'")
objComm.Execute
Rather than doing a 2nd discreet select, pulling the data in, then doing an update and pushing it back out just push out an update statement. This should speed up the processing of your records.....I know i used to write stuff in VB6 like this a long while back :)
So your code should now read like
dim objComm
set objComm = Server.CreateObject("ADODB.Command")`
objComm.ActiveConnection = objSystemCon.ActiveCon 'I think this is your connn.
objComm.CommandType = 1 'adCmdText
rs.Open "select reference,value1,datefield from datetable where field1 = 'value1' " & _
"order by reference", objAuditCon.ActiveCon, adOpenStatic, adLockPessimistic
Do While Not rs.EOF
intReadCount = intReadCount + 1
DoEvents
If Not IsNull(rs("value1")) Then
testArray = Split(rs("value1"), ",")
objComm.CommandText = "UPDATE DateTable SET DateField = (SELECT Date FROM TBL_TestTable WHERE Record_URN = '" & testArray(1) & "'")
objComm.Execute
End If
rs.MoveNext
Loop
rs.Close
your select statement is still there as you can see, it's a sub select now, the advantage being huge, you're not drawing records to the server, then updating them. You're sending the server a statement to do the updating. You're cutting your trips in half.
Hope this made sense.

Answer 2

Simple answer: take out the DoEvents statement. If you are using it to get screen refresh, the periodically do a manual refresh of your GUI after, say, 1000 iterations of the loop.
The reason why this may be causing an issue is that other code you may have no control over might be being executed when you call DoEvents.