VB6：ADODB.RecordSet.Open 在没有 DoEvents 的情况下失败

Question

我必须修复一些旧的 VB6 遗留代码中的某些内容，并发现以下内容：

Public Function openRec(db As ADODB.Connection, rs As ADODB.Recordset, sql As String) As Long
    On Error Resume Next
    rs.CursorLocation = adUseClient
    rs.CacheSize = 8000
    rs.Open sql, db, adOpenForwardOnly, adLockOptimistic
    DoEvents

    openRec = Err.Number
End Function

调用函数看起来像这样：

Public Function ShowDataGrid(sql As String)
    If openRec(DataDb, rs, sql) = 0 Then
        'WriteLog("Found Records: " & rs.RecordCount)
        If rs.RecordCount > 0 Then
            Do Until rs.EOF
                ' Do something with each record
                rs.MoveNext
                DoEvents
            Loop
        End IF
    End If
End Function

函数

openRec

只是打开调用者迭代的记录集。 然而，我对

DoEvents

感到好奇，当我将其注释掉时，该函数仅在一个 sql 语句上中断，所有其他语句都工作正常。 这是一条语句，从 SQL-Server 数据库返回大约 380k 记录集：

SELECT * FROM PRO_TEIL_AUFTRAG WHERE TETEILNR LIKE '%%' AND  PAAUFTRAG = 0 AND MEMERKMAL = 1 ORDER BY TETEILNR

如果

DoEvents

存在，一切正常，但如果我删除它，该功能将失败并显示

Err.Number: -2147217915, 
Err.Description: Das Objekt war geöffnet (something like "object was already opened")

有什么想法以及如何解决它吗？

我无法真正调试它，因为它在没有 IDE 的生产机器上运行。我只能使用

WriteLog

-语句。 在开发机器上，我使用一个小型访问数据库，仅返回一条记录，该记录在任何情况下都可以工作。

附加问题： 在调用代码中，当我取消注释

WriteLog

语句时，当我尝试访问

rs.RecordCount

:

时收到错误

Err: -2147024882
Description: Nicht genügend Arbeitsspeicher ("out of memory")

我不知道它是否有一些奇怪的VB6-Stuff，是否取决于操作系统（dev：win xp，prod：win7-64），数据库（dev：access，prod：sql server），数量返回的记录数（dev：1，prod：380k）或其他任何内容

Answer 1

首先，我会通过交换 WHERE 条件来优化 SQL 语句：

WHERE PAAUFTRAG = 0 AND MEMERKMAL = 1 AND TETEILNR LIKE '%%'

将速度较快的数字条件放在前面，这样可以减少后续条件必须处理的结果大小，为其余记录留下最慢的条件（字符串和 LIKE）。

而不是

rs.CursorLocation = adUseClient

尝试

rs.CursorLocation = adUseClient

。

这样您将丢失记录集的 .RecordCount 属性，但这可以规避，例如

Public Function ShowDataGrid(sql As String)
    If openRec(DataDb, rs, sql) = 0 Then
        If NOT (rs.BOF AND rs.EOF) Then
            Do Until rs.EOF
                ' Do something with each record
                rs.MoveNext
                ' DoEvents
            Loop
        End IF
    End If
End Function