CODEWITHSUNDEEP
excelvbaoracle-databaseadodb
Vasudha Dixit
Vasudha Dixit

Reputation: 377

Getting automation error while executing a procedure via VBA ADODB Recordset

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

I am calling a procedure which will update a flag to 'N' but getting Automation error at Set rsf_t = cnf.Execute(sqlstr) statement. Is the way of executing procedure is incorrect in my code? Not getting what is the issue here. I'd appreciate any help towards a solution for my problem.

Automation error

Upvotes: 0

Views: 875

Answers (1)

ComputerVersteher
ComputerVersteher

Reputation: 2686

To receive a recordset from a PL/SQL stored procedure with OraOLEDB Provider, you have to set PLSQLRSet property to TRUE.

See example from docs (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

Adapted to your code:

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

Upvotes: 1

Related Questions