VB6 & ADO 的问题

taskman

为什么 VB6 配 ADO 对一个约有五十万笔资料的资料库进行读写或查询动作很慢 ？？ 难道还有什么要添加的？？
DB= DBase III (*.DBF)

EXAMPLE
-----------------------------------------------------------------------------------------------------------------------------

Dim rst As New ADODB.Recordset
Dim hkrst As New ADODB.Recordset

rst.Open "TblStaff", cnn, adOpenForwardOnly, adLockReadOnly, adCmdTable
hkrst.Open "TblCLB", cnn, adOpenDynamic, adLockOptimistic, adCmdTable

With rst
    Do Until .EOF
        DoEvents
        If IsNull(!IDCode) = False Then
           hkrst.MoveFirst
            hkrst.Find "membercode = ' " & !IDCode & "'"
        
            If hkrst.EOF Then
               hkrst.AddNew
                    hkrst!membercode = !IDCode
                hkrst.Update
            End If
        End If
        .MoveNext
Loop
End With

rst.Close
hkrst.Close
Set rst = Nothing
Set hkrst = Nothing
-----------------------------------------------------------------------------------------------------------------------------

如果没有加上上述红色的Statement时，处理这一批资料时间约为二至三秒；现在却是用去了十分钟左右。
注：尝试使用 CONNECTION.EXECUTE 执行 SQL ， 结果效果似乎没差。


请问各位大哥大姐，能如何强化 ADO 的 ADDNEW RECORD 的速度？？

[ 本帖最后由 taskman 于 26-9-2005 11:58 AM 编辑 ]

goatstudio

我建议你用 select 和 insert 来写, 应该会比较快.

taskman

尝试使用下列SQL

SET HKRST = CNN.EXECUTE("SELECT MEMBERCODE FROM TBLCLB WHERE MEMBERCODE ='" & !IDCode & "'", 1, adCmdText)
代替
hkrst.Find "membercode = ' " & !IDCode & "'"
(** cnn 为一 ADODB.CONNECTION)

以及

CMD.CommandText="INSERT INTO TBLCLB (MEMBERCODE) VALUES ('" & !IDCode & "'"
CMD.EXECUTE
代替
hkrst.AddNew
hkrst!membercode = !IDCode
hkrst.Update
(** CMD 为一 ADODB.COMMAND)


似乎速度都没有改变。怎么办？？

[ 本帖最后由 taskman 于 26-9-2005 01:50 PM 编辑 ]

goatstudio

建议你再用 F8 去 trace 每一个行, 看看那一行运行最久.

taskman

查过了，不管是使用ADO的CONNECTION执行SQL COMMAND 或是使用ADO.FIND / FILTER都很慢。 今天使用回DAO，却是比ADO快很多！！！！！！！！ 不可思议吧！

另外，参考了大部分的文献。发觉ADO在执行ADD NEW或是MOVE COMMAND之类的，贬多于褒。太失望了。。。。

別失望，我之前都有過和你同樣的問題。後來，用 BatchUpdate 就行了。
我的DB和你不一樣，我是ＳＱＬ的。
如果你不介意的話，你可以試試這個

'BeginUpdateBatchVB
Public Sub Main()
    On Error GoTo ErrorHandler

    'To integrate this code
    'replace the data source and initial catalog values
    'in the connection string

    'connection and recordset variables
    Dim rstTitles As ADODB.Recordset
    Dim Cnxn As ADODB.Connection
    Dim strCnxn As String
    Dim strSQLTitles As String
     'record variables
    Dim strTitle As String
    Dim strMessage As String
   
    ' Open connection
    Set Cnxn = New ADODB.Connection
    strCnxn = "Provider='sqloledb';Data Source='MySqlServer';" & _
        "Initial Catalog='Pubs';Integrated Security='SSPI';"
    Cnxn.Open strCnxn
   
     ' open recordset for batch uodate
    Set rstTitles = New ADODB.Recordset
    strSQLTitles = "titles"
    rstTitles.Open strSQLTitles, Cnxn, adOpenKeyset, adLockBatchOptimistic, adCmdTable
   
    rstTitles.MoveFirst
    ' Loop through recordset and ask user if she wants
    ' to change the type for a specified title.
    Do Until rstTitles.EOF
        If Trim(rstTitles!Type) = "psychology" Then
            strTitle = rstTitles!Title
            strMessage = "Title: " & strTitle & vbCr & _
               "Change type to self help?"
            
            If MsgBox(strMessage, vbYesNo) = vbYes Then
                rstTitles!Type = "self_help"
            End If
        End If
   
        rstTitles.MoveNext
    Loop
   
    ' Ask the user if she wants to commit to all the
    ' changes made above.
    If MsgBox("Save all changes?", vbYesNo) = vbYes Then
        rstTitles.UpdateBatch
    Else
        rstTitles.CancelBatch
    End If
   
    ' Print current data in recordset.
    rstTitles.Requery
    rstTitles.MoveFirst
    Do While Not rstTitles.EOF
        Debug.Print rstTitles!Title & " - " & rstTitles!Type
        rstTitles.MoveNext
    Loop
   
    ' Restore original values because this is a demonstration.
    rstTitles.MoveFirst
    Do Until rstTitles.EOF
        If Trim(rstTitles!Type) = "self_help" Then
            rstTitles!Type = "psychology"
        End If
        rstTitles.MoveNext
    Loop
    rstTitles.UpdateBatch

    ' clean up
    rstTitles.Close
    Cnxn.Close
    Set rstTitles = Nothing
    Set Cnxn = Nothing
    Exit Sub
   
ErrorHandler:
    ' clean up
    If Not rstTitles Is Nothing Then
        If rstTitles.State = adStateOpen Then rstTitles.Close
    End If
    Set rstTitles = Nothing
   
    If Not Cnxn Is Nothing Then
        If Cnxn.State = adStateOpen Then Cnxn.Close
    End If
    Set Cnxn = Nothing
   
    If Err <> 0 Then
        MsgBox Err.Source & "-->" & Err.Description, , "Error"
    End If
End Sub
'EndUpdateBatchVB