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

 收藏

I have used the ADO function CheckInvTotals in an Access 2010 database for 5 years without a problem. Recently I have migrated to Office 2019 and this function failed returning the following message:

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

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

I reference Microsoft ActiveX Data Objects 6.1 Library. I would like to know why ADO fails and receive suggestions as to what I might try to eliminate the error in the ADO routine.

  1. I have tried referencing an earlier version of ADO to no avail
  2. The enclosed DAO code CheckInvTotals2 functions without error
  3. The ADO failure also occurs in 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]));

The code should simply return true or false.

回复
  • 逗小逼 回复

    有点晚了,但今天我遇到了这个问题,也许还有其他一些人。

    MS Infos: 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"))
    ```