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

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

1 个答案: