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

Question

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

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

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

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

1. 我曾尝试引用 ADO 的早期版本，但无济于事
2. 随附的 DAO 代码CheckInvTotals2正常运行
3. ADO 故障也出现在 Office 2016 中

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

SQL qryprmInvDiff：

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。

标签： vbams-accessadodao

Answer 1

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

微软信息：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"))
```