ADO 错误没有足够的内存资源来完成此操作

Posted 2023-04-18

【中文标题】ADO 错误没有足够的内存资源来完成此操作

【英文标题】：ADO Error Not enough memory resources are available to complete this operation

【发布时间】：2019-10-15 19:21:45

【问题描述】：

我已经在 Access 2010 数据库中使用 ADO 函数CheckInvTotals 5 年了，没有出现任何问题。最近我迁移到 Office 2019 并且此函数失败返回以下消息：

错误 -2147024882（没有足够的内存资源来完成此操作。）

我可以绕过启动表单来测试这个功能。以这种方式执行函数仍然失败并出现上述错误，因此其他运行对象不太可能导致内存泄漏。

我参考Microsoft ActiveX Data Objects 6.1 Library。 我想知道 ADO 失败的原因并收到有关我可以尝试消除 ADO 例程中的错误的建议。

我曾尝试引用 ADO 的早期版本，但无济于事 封闭的 DAO 代码CheckInvTotals2 正常运行 Office 2016 中也会出现 ADO 故障

Public Function CheckInvTotals(lngPayID As Long) As Boolean
    'Is there a difference between Invoice Total and payment amount

    Dim cmd As New ADODB.Command
    Dim rst As New ADODB.Recordset

    On Error GoTo CheckInvTotals_Error

    With cmd
        .CommandText = "qryprmInvDiff"
        .CommandType = adCmdStoredProc
        Set .ActiveConnection = CurrentProject.Connection
        .Parameters.Append .CreateParameter("PayID", adBigInt, adParamInput, , lngPayID)
        rst.CursorType = adOpenStatic
        Set rst = .Execute
    End With

    CheckInvTotals = rst.EOF
    rst.Close

CheckInvTotals_Error:
    If Err Then
        MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
    End If

    Set rst = Nothing
    Set cmd = Nothing
End Function

Public Function CheckInvTotals2(lngPayID As Long) As Boolean
    'Is there a difference between Invoice Total and payment amount

    Dim db As Database
    Dim qd As DAO.QueryDef
    Dim prmPayID As DAO.Parameter
    Dim rst As DAO.Recordset

    On Error GoTo Handle_err

    Set db = CurrentDb
    Set qd = db.QueryDefs("qryprmInvDiff")
    Set prmPayID = qd.Parameters!PayID
    prmPayID.Value = lngPayID

    Set rst = qd.OpenRecordset
    CheckInvTotals2 = rst.EOF
    rst.Close

Handle_err:
    If Err Then
        MsgBox "Error " & Format(Err.Number) & " " & Err.Description
        Err.Clear
    End If

    On Error Resume Next
    Set rst = Nothing
    Set prmPayID = Nothing
    Set qd = Nothing
    Set db = Nothing

End Function

SQLqryprmInvDiff:

PARAMETERS PayID Long;
SELECT Creditors.CName, Creditors.Code, [InvTotal]-[Amount] AS Diff FROM 
Creditors INNER JOIN (Payments INNER JOIN qryPayInvTotal ON 
Payments.ID = qryPayInvTotal.PayID) ON Creditors.ID = Payments.CID
WHERE ((([InvTotal]-[Amount])<>0) AND ((Payments.PID)=[PayID]));

代码应该简单地返回true 或false。

【问题讨论】：

您检索 Recordset 纯粹是为了查看是否有任何记录。您应该编写一个 SQL 命令，该命令将返回记录的计数，该计数将指示零或非零，这将更有效率。您还应该指定adForwardOnly，除非您特别需要向后移动记录（在您的示例中没有这样做）。每个查询都应该带回您需要的最少量数据。它更快、更高效。

您是否考虑过问题是否是由于使用了 64 位 Microsoft Access 造成的？

谢谢@Gareth。同意，简单地测试 EOF 状态而不是返回记录计数是我的糟糕形式。但是，将查询修改为对返回的记录求和失败，并出现错误...表达式太复杂，无法评估。我想这就是我选择 EOF 测试的原因。我已修改光标以使用 adOpenForwardOnly 没有成功

谢谢@UnhandledException 确实，进一步阅读表明 ADO.Net 可以解决问题，但这不是 Access 中使用 VBA 的选项。多年前，我相信 DAO 会被 ADO 取代，所以我尽可能地尝试使用 ADO。现在看来，在 Office/VBA 环境中，MS 更喜欢 DAO

【参考方案1】：

有点太晚了，但今天我遇到了这个问题，也许其他人也有......

MS 信息：https://docs.microsoft.com/en-us/office/troubleshoot/access/adbigint-data-type-errors

解决方案：将 adBigInt 更改为更合适的值，在我的情况下 adNumeric 可以完成这项工作

  Set Cmd = New ADODB.Command

  RS.MoveFirst

  With Cmd
    .ActiveConnection = CurrentProject.Connection
    .CommandType = adCmdText
    .CommandText = strSQL

    .Parameters.Append .CreateParameter("@idposition", adChar, adParamInput, 36, strGUID)
    .Parameters.Append .CreateParameter("@idbeleg", adChar, adParamInput, 36, RS.Fields("idbeleg"))

    ' ########### A2019 > adBigInt changed to adNumeric (Database Datatype: Long (Integer))
    '.Parameters.Append .CreateParameter("@sortnr", adBigInt, adParamInput, , RS.Fields("sortnr"))

    .Parameters.Append .CreateParameter("@sortnr", adNumeric, adParamInput, , RS.Fields("sortnr"))
```