通过 VBA ADODB Recordset 执行过程时出现自动化错误

Question

Private Sub Check_FLag_Click()
        Dim cnf As ADODB.Connection
        Dim rsf As ADODB.Recordset
        Dim rsf_t As ADODB.Recordset
        Dim mtxDataf As Variant
        Dim mtxDatasf As Variant
        Dim mtxDatatf As Variant
        Dim i_f As Integer
        Dim answer As Integer
        Dim sqlstr As String
        
        
     
        Set cnf = New ADODB.Connection
        Set rsf = New ADODB.Recordset
        Set rsf_t = New ADODB.Recordset
        
        cnf.Open ( _
        "User ID=x1xxxx" & _
        ";Password=x2xxxxx" & _
        ";Data Source=x3xxxx" & _
        ";Provider=OraOLEDB.Oracle")
        
        
        mtxDatasf = ThisWorkbook.Sheets("Sheet3").Range("A1").Value
        
        rsf.Open (mtxDatasf), cnf, adOpenStatic
        
    
        mtxDataf = rsf.RecordCount
        
        Worksheets(1).Activate
        
        
        If CDec(mtxDataf) = 0 Then
            ActiveSheet.Range("D5") = "Done - FLag is N for all model"
        Else
            ActiveSheet.Range("D5") = "No. of models having flag as Y " & mtxDataf
            answer = MsgBox(Join$(Split(Range("F5").Value, vbCrLf), " ") & " are having flag as Y. Do you want to update it now?", vbYesNo + vbQuestion)
            If answer = vbYes Then
                Do While Not rsf.EOF
                    i_f = 0
                    mtxDatatf = mtxDatatf & rsf.Fields(i_f).Value & vbCrLf
                    sqlstr = "exec JI_" & rsf.Fields(i_f).Value & "_DBA.ke_var_pkg.k_var_rec('UPD','KE_RECLOG','a.flag = ''N'''); COMMIT;"
                    Set rsf_t = cnf.Execute(sqlstr)
                    rsf.MoveNext
                Loop
                ActiveSheet.Range("F5") = mtxDatatf
        
            End If
        End If
        
        
        
        'Cleanup in the end
        Set rsf = Nothing
        Set cnf = Nothing
        Set rsf_t = Nothing
End Sub

我正在调用一个将标志更新为“N”但在Set rsf_t = cnf.Execute(sqlstr) 语句处出现自动化错误的过程。我的代码中执行程序的方式是否不正确？没有得到这里的问题。对于解决我的问题的任何帮助，我将不胜感激。

Answer 1

要使用 OraOLEDB 提供程序从 PL/SQL 存储过程接收记录集，您必须将 PLSQLRSet 属性设置为 TRUE。

参见文档中的示例 (OraOLEDB Custom Properties for Commands)：

Example: Setting the Custom Property PLSQLRSet
Dim objRes As NEW ADODB.Recordset
Dim objCon As NEW ADODB.Connection
Dim objCmd As NEW ADODB.Command
....
objCmd.ActiveConnection = objCon
objCmd.CommandType = adCmdText

' Enabling the PLSQLRSet property indicates to the provider
' that the command returns one or more rowsets
objCmd.Properties("PLSQLRSet") = TRUE

' Assume Employees.GetEmpRecords() has a REF CURSOR as
' one of the arguments
objCmd.CommandText = "{ CALL Employees.GetEmpRecords(?,?) }"

' Execute the SQL
set objRes = objCmd.Execute

' It is a good idea to disable the property after execute as the
' same command object may be used for a different SQL statement
objCmd.Properties("PLSQLRSet") = FALSE

适应您的代码：

Private Sub Check_FLag_Click()
        Dim cnf As ADODB.Connection
        Dim rsf As ADODB.Recordset
        Dim rsf_t As ADODB.Recordset
        Dim mtxDataf As Variant
        Dim mtxDatasf As Variant
        Dim mtxDatatf As Variant
        Dim i_f As Integer
        Dim answer As Integer
        Dim sqlstr As String
        
        
     
        Set cnf = New ADODB.Connection
        Set rsf = New ADODB.Recordset
        Set rsf_t = New ADODB.Recordset
        
        cnf.Open ( _
        "User ID=x1xxxx" & _
        ";Password=x2xxxxx" & _
        ";Data Source=x3xxxx" & _
        ";Provider=OraOLEDB.Oracle")
        
        
        mtxDatasf = ThisWorkbook.Sheets("Sheet3").Range("A1").Value
        
        rsf.Open (mtxDatasf), cnf, adOpenStatic
        
    
        mtxDataf = rsf.RecordCount
        
        Worksheets(1).Activate
        
        
        If CDec(mtxDataf) = 0 Then
            ActiveSheet.Range("D5") = "Done - FLag is N for all model"
        Else
            ActiveSheet.Range("D5") = "No. of models having flag as Y " & mtxDataf
            answer = MsgBox(Join$(Split(Range("F5").Value, vbCrLf), " ") & " are having flag as Y. Do you want to update it now?", vbYesNo + vbQuestion)
            If answer = vbYes Then
                Do While Not rsf.EOF
                    i_f = 0
                    mtxDatatf = mtxDatatf & rsf.Fields(i_f).Value & vbCrLf
                    sqlstr = "exec JI_" & rsf.Fields(i_f).Value & "_DBA.ke_var_pkg.k_var_rec('UPD','KE_RECLOG','a.flag = ''N'''); COMMIT;"
                    Dim cmd as ADODB.Command
                    Set cmd as New ADODB.Command
                    Set cmd.ActiveConnection = cnf
                    cmd.CommandType = adCmdText
                    cmd.Properties("PLSQLRSet") = TRUE
                    cmd.CommandText = sqlstr
                    Set rsf_t = cmd.Execute
                    cmd.Properties("PLSQLRSet") = FALSE
                    rsf.MoveNext
                Loop
                ActiveSheet.Range("F5") = mtxDatatf
        
            End If
        End If
        
        
        
        'Cleanup in the end
        Set rsf = Nothing
        Set cnf = Nothing
        Set rsf_t = Nothing
End Sub