実行時エラー3704 MS Access VBA呼び出しiSeriesストアド・プロシージャ

Question

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 

何が欠けていますか？

ありがとうございました。

Answer 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