VB6 Recordset update

adorecordsetvb6

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

Best Answer

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.

Related Topic