Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

run-tune error 3704 operation is not allowed when the object is codes: I don't think so.

morechocolate

Technical User
Apr 5, 2001
225
0
16
US
I am receiving "run-tune error 3704 operation is not allowed when the object is codes" error in Excel. The debug takes me to the first line of the following code (comes after the SQL code):

Code:
If Not rsData.EOF Then
        ' Add headers to the worksheet.
        With ThisWorkbook.Sheets("Data Dump").Range("A1")
            For Each objField In rsData.Fields
                .Offset(0, lOffset).Value = objField.Name
                lOffset = lOffset + 1
            Next objField
            .Resize(1, rsData.Fields.Count).Font.Bold = True
        End With

Running the code piece by piece (running the temporary table one by one) I determined the issue is related to the code using the max function. I was originally getting the error before those lines, but I was able to modify the code for the temporary tables that were causing the same error. The code using the max function has me stumped. I have tried a variety of things, but I cannot get past that particular temporary table.

Assistance with determining a revision to the code causing the issue is greatly appreciated.

Code:
sSQL = "SET NOCOUNT ON"
        sSQL = sSQL & vbCrLf
     
sSQL = sSQL & "declare @acct_date as datetime"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "declare @matanalysisdate as datetime"
    sSQL = sSQL & vbCrLf

sSQL = sSQL & "select @acct_date = '" & DateEntered & "'"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "select @matanalysisdate = dateadd(qq, datediff(qq,0,getdate()), -1) --prior quarter end"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "--P. Burke added for the IO Only type since the IO_PERIOD in the datamart is the change in the period"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "IF OBJECT_ID('tempdb..#temp', 'U') IS NOT NULL DROP TABLE #temp;"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "IF OBJECT_ID('tempdb..#PrincipalTypeAnalysis', 'U') IS NOT NULL DROP TABLE #PrincipalTypeAnalysis;"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "IF OBJECT_ID('tempdb..#PrincipalType', 'U') IS NOT NULL DROP TABLE #PrincipalType;"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "IF OBJECT_ID('tempdb..#TempNONEFlag', 'U') IS NOT NULL DROP TABLE #TempNONEFlag;"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "IF OBJECT_ID('tempdb..#NONEStatus_TypeCount', 'U') IS NOT NULL DROP TABLE #NONEStatus_TypeCount;"
    sSQL = sSQL & vbCrLf
'sSQL = sSQL & "IF OBJECT_ID('tempdb..#LastIODate', 'U') IS NOT NULL DROP TABLE #LastIODate;"
'    sSQL = sSQL & vbCrLf
'sSQL = sSQL & "IF OBJECT_ID('tempdb..#PrincipalTypeName', 'U') IS NOT NULL DROP TABLE #PrincipalTypeName;"
'    sSQL = sSQL & vbCrLf

sSQL = sSQL & "-- Create #temp table"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "SELECT"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "    loan,"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "    i.principal_type,"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "    i.eff_thru_dte"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "INTO #temp"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "FROM instschd AS i"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "WHERE RTRIM(i.sched_type) <> 'COVID19';"
    sSQL = sSQL & vbCrLf

sSQL = sSQL & "-- Create #PrincipalTypeAnalysis table"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "SELECT"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "    loan,"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "    principal_type,"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "    eff_thru_dte,"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "    CASE"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "        WHEN LAG(principal_type) OVER (PARTITION BY loan ORDER BY eff_thru_dte) = 'NONE'"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "             AND principal_type <> 'NONE' THEN 1"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "        ELSE 0"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "    END As ChangeFromNONE"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "INTO #PrincipalTypeAnalysis"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "FROM #temp"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "ORDER BY loan, eff_thru_dte;"
    sSQL = sSQL & vbCrLf

sSQL = sSQL & "-- Create a temporary table to replace CTE_PrincipalType"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "SELECT"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "    loan,"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "    CASE"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "        WHEN SUM(ChangeFromNONE) > 0 THEN 'IOThenAmortizing'"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "        Else 'Stable'"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "    END As PrincipalType"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "INTO #PrincipalType"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "FROM #PrincipalTypeAnalysis"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "GROUP BY loan;"
    sSQL = sSQL & vbCrLf
 
sSQL = sSQL & "-- First, create a flag for 'NONE' principal_type for each loan"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "    SELECT"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "        t.loan,"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "        IIF(t.principal_type = 'NONE', 1, 0) AS NONEFlag"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "    INTO #TempNONEFlag"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "    FROM #temp t;"
    sSQL = sSQL & vbCrLf

sSQL = sSQL & "-- Then, aggregate the results to get the NONEStatus"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "    SELECT"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "        f.loan,"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "        IIF(SUM(f.NONEFlag) > 0, 'Contains NONE', 'No NONE') AS NONEStatus,"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "        COUNT(DISTINCT t.principal_type) AS TypeCount"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "    INTO #NONEStatus_TypeCount"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "    FROM #temp t"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "   JOIN #TempNONEFlag f ON t.loan = f.loan"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "    GROUP BY f.loan;"
    sSQL = sSQL & vbCrLf
 
sSQL = sSQL & "-- Create a temporary table to replace CTE_LastIODate"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "SELECT"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "    loan,"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "    MAX(CASE WHEN principal_type = 'NONE' THEN eff_thru_dte ELSE NULL END) AS LastIODate"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "INTO #LastIODate"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "FROM #temp"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "WHERE eff_thru_dte Is Not Null"
    sSQL = sSQL & vbCrLf
sSQL = sSQL & "GROUP BY loan;"
    sSQL = sSQL & vbCrLf

sSQL = sSQL & "select * from #LastIODate"
    sSQL = sSQL & vbCrLf

sSQL = sSQL & "SET ANSI_WARNINGS ON"
    sSQL = sSQL & vbCrLf
 
It's hard to follow what you're trying to do but I suspect that you're trying to run a multi-step series of queries in one database call.

Break down the calls into multiple steps. Your temp table will remain in place until you're ready to get rid of it.

When you're running some SQL that doesn't return data, like all of the queries that are inserting into the temp table, you'll call something like:

Code:
YourADOConnection.Execute(sSQL)

Then, when you get to the very last step and you want to query the contents of the Temp table, then make your call to rsData.Open.

And, as an aside, you can shorten your code base with something like which will be easier on your brain:

Code:
sSQL = sSQL & "-- Create #temp table" & vbCrLf
sSQL = sSQL & "SELECT" & vbCrLf
sSQL = sSQL & "    loan," & vbCrLf
sSQL = sSQL & "    i.principal_type,"  & vbCrLf
 
It's hard to follow what you're trying to do but I suspect that you're trying to run a multi-step series of queries in one database call.

Break down the calls into multiple steps. Your temp table will remain in place until you're ready to get rid of it.

When you're running some SQL that doesn't return data, like all of the queries that are inserting into the temp table, you'll call something like:

Code:
YourADOConnection.Execute(sSQL)

Then, when you get to the very last step and you want to query the contents of the Temp table, then make your call to rsData.Open.

And, as an aside, you can shorten your code base with something like which will be easier on your brain:

Code:
sSQL = sSQL & "-- Create #temp table" & vbCrLf
sSQL = sSQL & "SELECT" & vbCrLf
sSQL = sSQL & "    loan," & vbCrLf
sSQL = sSQL & "    i.principal_type,"  & vbCrLf
Thank You for your response.

This is the code I currently have.
Code:
   'create connection string
    sConnect = "Provider=SQLOLEDB;" & _
               "Data Source=" & ServerName & ";" & _
               "Initial Catalog=LMS_NYL;" & _
               "Integrated Security=SSPI"

    'create the connection and recrodset objects
    Set objConn = New ADODB.Connection

    'Set CONNECTION timeout property
    objConn.CommandTimeout = 0

'    Create a new command object to process the stored proc
    Set cmdl = New ADODB.Command

        With cmdl
            .ActiveConnection = sConnect
            'set COMMAND timeout property - query can time out on either the connection OR the command
            .CommandTimeout = 0
            .CommandText = sSQL
            .CommandType = adCmdText
'            .Refresh False
            Set rsData = .Execute()
    End With
    
    'Delete Query Results sheet if it exists
    On Error Resume Next
    Application.DisplayAlerts = False

    ThisWorkbook.Sheets("Data Dump").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    'Add Query Results sheet
    ThisWorkbook.Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Data Dump"
    
   'make sure data is returned
    If Not rsData.EOF Then
        ' Add headers to the worksheet.
        With ThisWorkbook.Sheets("Data Dump").Range("A1")
            For Each objField In rsData.Fields
                .Offset(0, lOffset).Value = objField.Name
                lOffset = lOffset + 1
            Next objField
            .Resize(1, rsData.Fields.Count).Font.Bold = True
        End With

        'dump the contents of the recorrdset onto the worksheet
        ThisWorkbook.Sheets("Data Dump").Range("A2").CopyFromRecordset rsData

        'close the recordset
        rsData.Close

        
        'fit the column widths to the data
        ThisWorkbook.Sheets("Data Dump").UsedRange.EntireColumn.AutoFit
        
        ThisWorkbook.Sheets("Data Dump").Move Before:=Sheets(2)

    Else
        MsgBox "Error: No records returned. Verify the year entered", vbCritical
        Exit Sub
    End If

    'clean up our ADO objects
    If CBool(objConn.State And adStateOpen) Then objConn.Close
    Set objConn = Nothing
    Set rsData = Nothing
    
    Call SaveAsCSV
    
    ThisWorkbook.Sheets("Data Dump").Range("A1").Select
    
'    Call AddFormulas

    Workbooks(BkName).Worksheets("Notes").Activate
        
    Application.ScreenUpdating = True
 
I assume you have Option Explicit at the top of your code and all your variables (sConnect, rsData, etc.) are declared somewhere, right?
 
Thank You for your response.

This is the code I currently have.
Code:
   'create connection string
    sConnect = "Provider=SQLOLEDB;" & _
               "Data Source=" & ServerName & ";" & _
               "Initial Catalog=LMS_NYL;" & _
               "Integrated Security=SSPI"

    'create the connection and recrodset objects
    Set objConn = New ADODB.Connection

    'Set CONNECTION timeout property
    objConn.CommandTimeout = 0

'    Create a new command object to process the stored proc
    Set cmdl = New ADODB.Command

        With cmdl
            .ActiveConnection = sConnect
            'set COMMAND timeout property - query can time out on either the connection OR the command
            .CommandTimeout = 0
            .CommandText = sSQL
            .CommandType = adCmdText
'            .Refresh False
            Set rsData = .Execute()
    End With
   
    'Delete Query Results sheet if it exists
    On Error Resume Next
    Application.DisplayAlerts = False

    ThisWorkbook.Sheets("Data Dump").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    'Add Query Results sheet
    ThisWorkbook.Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Data Dump"
   
   'make sure data is returned
    If Not rsData.EOF Then
        ' Add headers to the worksheet.
        With ThisWorkbook.Sheets("Data Dump").Range("A1")
            For Each objField In rsData.Fields
                .Offset(0, lOffset).Value = objField.Name
                lOffset = lOffset + 1
            Next objField
            .Resize(1, rsData.Fields.Count).Font.Bold = True
        End With

        'dump the contents of the recorrdset onto the worksheet
        ThisWorkbook.Sheets("Data Dump").Range("A2").CopyFromRecordset rsData

        'close the recordset
        rsData.Close

       
        'fit the column widths to the data
        ThisWorkbook.Sheets("Data Dump").UsedRange.EntireColumn.AutoFit
       
        ThisWorkbook.Sheets("Data Dump").Move Before:=Sheets(2)

    Else
        MsgBox "Error: No records returned. Verify the year entered", vbCritical
        Exit Sub
    End If

    'clean up our ADO objects
    If CBool(objConn.State And adStateOpen) Then objConn.Close
    Set objConn = Nothing
    Set rsData = Nothing
   
    Call SaveAsCSV
   
    ThisWorkbook.Sheets("Data Dump").Range("A1").Select
   
'    Call AddFormulas

    Workbooks(BkName).Worksheets("Notes").Activate
       
    Application.ScreenUpdating = True
I have it working now. Thank You
 

Part and Inventory Search

Sponsor

Back
Top