运行时错误 3704 MS Access VBA 调用 iSeries 存储过程答案

【问题标题】：Run Time Error 3704 MS Access VBA call iSeries Stored Procedure运行时错误 3704 MS Access VBA 调用 iSeries 存储过程
【发布时间】：2017-08-14 16:04:40
【问题描述】：

我正在使用 MS Access 2013 并调用 IBM iSeries 存储过程，传递参数值并将结果附加到本地 Access 表中。这是我的代码：

Option Explicit
Dim Cm As New ADODB.Command
Dim C As New ADODB.Connection
Dim cn As ADODB.Connection
Dim rsti400 As ADODB.Recordset
Dim cmd As ADODB.Command
Dim prm, prm1 As ADODB.Parameter
Dim i As Integer
Dim rs As ADODB.Recordset
Dim rst, rst400 As DAO.Recordset
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
Dim CONO, SEA1, CUNO, TCCD, RCCD, ITNO, DATE, TLIST, RLIST, LR, TPRICE, RPRICE, FVDT, LVDT, SPUN, ERR, sHeader As String

Private Sub Command191_Click()
   'Define parameters
    CONO = "001"
    SEA1 = "2018SS"
    CUNO = ""
    TCCD = "GBP"
    RCCD = "GBP"
    ITNO = "ITEM123456"
    DATE = "00000000"
    TLIST = "0T"
    RLIST = "0S"
    LR = "Y"
    TPRICE = "0000000000"
    RPRICE = "0000000000"
    FVDT = "0000000000"
    LVDT = "0000000000"
    SPUN = ""
    ERR = ""

    'clear local table
   DoCmd.RunSQL "DELETE tblIBM_Import.* FROM tblIBM_Import", -1

    'If C.State = adStateOpen Then C.Close

    C.Open "Driver=iSeries Access ODBC Driver;" & _
    "SYSTEM=xxx.xxx.xxx.xxx;UID=xxxxxx;PWD=xxxxxxx;"

    Cm.ActiveConnection = C

    Cm.CommandType = adCmdText

    Cm.CommandText = "{CALL QGPL.GETPRICESP(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)}"

    Cm.Parameters.Append Cm.CreateParameter("CONO", adChar, adParamInput, 3, CONO)
    Cm.Parameters.Append Cm.CreateParameter("SEA1", adChar, adParamInput, 6, SEA1)
    Cm.Parameters.Append Cm.CreateParameter("CUNO", adChar, adParamInput, 10, CUNO)
    Cm.Parameters.Append Cm.CreateParameter("TCCD", adChar, adParamInput, 3, TCCD)
    Cm.Parameters.Append Cm.CreateParameter("RCCD", adChar, adParamInput, 3, RCCD)
    Cm.Parameters.Append Cm.CreateParameter("ITNO", adChar, adParamInput, 15, ITNO)
    Cm.Parameters.Append Cm.CreateParameter("DATE", adChar, adParamInput, 8, DATE)
    Cm.Parameters.Append Cm.CreateParameter("TLIST", adChar, adParamInput, 2, TLIST)
    Cm.Parameters.Append Cm.CreateParameter("RLIST", adChar, adParamInput, 2, RLIST)
    Cm.Parameters.Append Cm.CreateParameter("LR", adChar, adParamInput, 1, LR)
    Cm.Parameters.Append Cm.CreateParameter("TPRICE", adChar, adParamInput, 10, TPRICE)
    Cm.Parameters.Append Cm.CreateParameter("RPRICE", adChar, adParamInput, 10, RPRICE)
    Cm.Parameters.Append Cm.CreateParameter("FVDT", adBigInt, adParamInput, 8, FVDT)
    Cm.Parameters.Append Cm.CreateParameter("LVDT", adBigInt, adParamInput, 8, LVDT)
    Cm.Parameters.Append Cm.CreateParameter("SPUN", adChar, adParamInput, 3, SPUN)
    Cm.Parameters.Append Cm.CreateParameter("ERR", adChar, adParamInput, 1, ERR)

    ' Debug code to ensure parameters are set correctly
    For Each prm In Cm.Parameters
    Debug.Print prm.Name & " : " & prm.Value
    Next

    '=======================
    'Fetch data into Recordset
    '=======================

    'If rsti400.State = adStateOpen Then rsti400.Close

    Set rsti400 = Cm.Execute

    If rsti400.EOF Then

    MsgBox "The Recordset is empty"

    End If

    '=======================
    'Retrieve column headers
    '=======================
    i = 0
    sHeader = ""

    For i = 0 To rsti400.Fields.Count - 1
    sHeader = sHeader & rsti400.Fields.Item(i).Name & vbTab
    Next i
    'Debug.Print sHeader

    Set rst400 = CurrentDb.OpenRecordset("tblIBM_Import", dbOpenDynaset, dbSeeChanges)

    'Loop through recordset and place values
    Do While rsti400.EOF = False

    With rst400
    .AddNew
    .Fields("CONO") = rsti400.Fields("CONO")
    .Fields("SEA1") = rsti400.Fields("SEA1")
    .Fields("CUNO") = rsti400.Fields("CUNO")
    .Fields("TCCD") = rsti400.Fields("TCCD")
    .Fields("RCCD") = rsti400.Fields("RCCD")
    .Fields("ITNO") = rsti400.Fields("ITNO")
    .Fields("DATE") = rsti400.Fields("DATE")
    .Fields("TLIST") = rsti400.Fields("TLIST")
    .Fields("RLIST") = rsti400.Fields("RLIST")
    .Fields("LR") = rsti400.Fields("LR")
    .Fields("TPRICE") = rsti400.Fields("TPRICE")
    .Fields("RPRICE") = rsti400.Fields("RPRICE")
    .Fields("FVDT") = rsti400.Fields("FVDT")
    .Fields("LVDT") = rsti400.Fields("LVDT")
    .Fields("SPUN") = rsti400.Fields("SPUN")
    .Fields("ERR") = rsti400.Fields("ERR")
    .Update

    End With
    rsti400.MoveNext
    Loop

    'close connections


    rsti400.Close
    rst400.Close
    C.Close

    Set rst400 = Nothing
    Set rsti400 = Nothing
    Set Cm = Nothing
    Set C = Nothing
End Sub

但是，当我执行时收到错误：

运行时错误 3704 - 对象关闭时不允许操作

下面的代码会被高亮显示

If rsti400.EOF Then

我错过了什么？

谢谢。

【问题讨论】：

执行前你在哪里准备？
请使用Option Explicit 并显示所有变量声明及其对象类型。
我已经添加了声明。 @mao - 我不完全理解 - 我只是调用 SP 并传递参数。
你需要`Cm.CommandType = amdCdStoredProc`吗？
我只是将它作为文本：Cm.CommandType = adCmdText

标签： vba ms-access db2

【解决方案1】：

我得到它的工作 - SP 有 OUT 参数，所以我必须将这些分配给字段：

Set rst400 = CurrentDb.OpenRecordset("tblIBM_Import", dbOpenDynaset, dbSeeChanges)

With rst400
.AddNew
.Fields("ITNO") = cm.Parameters(5)
.Fields("TPRICE") = CCur(Left$(cm.Parameters(10), 8) & "." & Right$(cm.Parameters(10), 2))
.Fields("RPRICE") = CCur(Left$(cm.Parameters(11), 8) & "." & Right$(cm.Parameters(11), 2))
.Update

End With

【讨论】：