通過 VBA ADODB 記錄集執行過程時出現自動化錯誤

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 自定義屬性）：

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