Ошибка ADO Недостаточно ресурсов памяти для выполнения этой операции - PullRequest
2 голосов
/ 30 мая 2019

Я использовал функцию ADO CheckInvTotals в базе данных Access 2010 в течение 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.

...