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 Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Excel 2007 VBA "operation is not allowed when the object is closed"

Status
Not open for further replies.

makeitwork09

Technical User
Sep 28, 2009
170
US
I am using Excel 2007.

The data being extracted from the following code is in Microsoft SQL Server 2005.

At the line below I am getting the error "operation is not allowed when the object is closed". I searched and searched the web, but I cannot figure out what is wrong.

I did ?sSQL in the Immediate Window, then pasted the results in SQL Server to verify nothing was wrong. Indeed, in SQL Server, the code ran without error.

Any ideas?


Code:
If Not rsData.EOF Then

Code:
Sub DataDumpQuery()

    Dim cmdl As ADODB.Command
    Dim objConn As ADODB.Connection
    Dim rsData As ADODB.Recordset
    Dim objField As ADODB.Field
    Dim lOffset As Long
    Dim sConnect As String
    Dim sSQL As String
    Dim ServerName As String
    
    Application.ScreenUpdating = False
    
    ServerName = ThisWorkbook.Sheets("Notes").Range("D3").Value

    sSQL = "SET NOCOUNT ON;"
    sSQL = sSQL & vbCrLf
    
    sSQL = sSQL & "if OBJECT_ID('tempdb..#impairments' ,'u') is not null drop table #impairments"
    sSQL = sSQL & vbCrLf
    
    sSQL = sSQL & "select"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "i.accounting_date,i.participant,i.loan,i.tran_sub_type,i.cash_date,i.loan_kind"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "into #impairments"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "from (select ROW_NUMBER() OVER (partition by d.loan,d.participant ORDER BY"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "   d.accounting_date asc) as [rownum],d.accounting_date,d.participant,d.loan,d.tran_sub_type,d.cash_date,"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "   l.loan_kind"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & " from LMS_V11_YE_2011..ddethist d"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & " join LMS_V11_YE_2011..loanhist l on"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "l.loan = d.loan and"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "l.accounting_date = d.accounting_date"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & " join LMS_V11_YE_2011..partmast u on"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "u.participant = d.participant"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & " where d.tran_sub_type = 'bkvaladj'"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "   and l.loan_kind not like 'sf%'"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "   and u.investor_type = 'internal'"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "   and d.participant != 'nylim'"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & " group by d.accounting_date,d.participant,d.loan,d.tran_sub_type,d.cash_date,l.loan_kind) as i"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "where i.rownum = 1"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "order by i.loan"
    sSQL = sSQL & vbCrLf
    
    
    sSQL = sSQL & "if OBJECT_ID('tempdb..#allocation' ,'u') is not null drop table #allocation"
    sSQL = sSQL & vbCrLf
    
    sSQL = sSQL & "select h.loan,f.loan_xref,h.participant,h.accounting_date,"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "case when g.port_loan = 'Y' then "
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "g.port_name"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "else"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "case when charindex(rtrim(t.loan), t.loan_name) != 0 then rtrim(substring(t.loan_name,1,charindex(rtrim(t.loan), t.loan_name)-1)) else t.loan_name end"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "    end as [loan_name],"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "sum(case"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "when q.total_value is null and o.appr_final_val is null then"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "h.inv_int_due_bal_p/r.number_of_properties"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "when isnull(q.total_value,0) = 0 then"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "h.inv_int_due_bal_p"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "else "
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "(isnull(o.appr_final_val,0) / q.total_value) * h.inv_int_due_bal_p"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "end) as [int_due_bal_p],"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "sum(case"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "when q.total_value is null and o.appr_final_val is null then"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "h.inv_int_coll_p/r.number_of_properties"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "when isnull(q.total_value,0) = 0 then"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "h.inv_int_coll_p"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "else "
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "(isnull(o.appr_final_val,0) / q.total_value) * h.inv_int_coll_p"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "end) as [int_coll_p],"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "sum(case when q.total_value is null and o.appr_final_val is null then"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "h.inv_prepd_int_bal_p/r.number_of_properties"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "when isnull(q.total_value,0) = 0 then"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "h.inv_prepd_int_bal_p"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "else "
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "(isnull(o.appr_final_val,0) / q.total_value) * h.inv_prepd_int_bal_p"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "end) as [prepd_int_bal_p],"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "sum(case when q.total_value is null and o.appr_final_val is null then"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "h.inv_accrd_int_bal_p/r.number_of_properties"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "when isnull(q.total_value,0) = 0 then"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "h.inv_accrd_int_bal_p"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "else "
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "(isnull(o.appr_final_val,0) / q.total_value) * h.inv_accrd_int_bal_p"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "end) as [accrd_int_bal_p],"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "o.system_type,o.prop_type"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "into #allocation"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "from (select p.loan,p.participant,p.accounting_date,isnull(sum(p.int_due_bal_p),0) as [inv_int_due_bal_p],"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "      isnull(sum(p.prepd_int_bal_p),0) as [inv_prepd_int_bal_p],"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "      isnull(sum(p.int_coll_p),0) as [inv_int_coll_p],"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "      isnull(sum(p.accrd_int_bal_p),0) as [inv_accrd_int_bal_p]"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "      from LMS_V11_YE_2011..porthist p"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "      group by p.loan,p.participant,p.accounting_date) as h"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "left outer join LMS_V11_YE_2011..nyl_property_appr as o on h.loan = o.loan"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "left outer join LMS_V11_YE_2011..nyl_loan_appr_value as q on h.loan = q.loan"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "left outer join (select l.loan,count(code) as number_of_properties "
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & " from LMS_V11_YE_2011..loancoll l WITH (NOLOCK)"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & " where l.release_date is null "
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & " group by l.loan) as r on "
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "r.loan = o.loan"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "left outer join LMS_V11_YE_2011..loanhist as t on"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "t.loan = h.loan and"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "    t.accounting_date = h.accounting_date"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "left outer join LMS_V11_YE_2011..partmast as a on"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "a.participant = h.participant"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "left outer join LMS_V11_YE_2011..nyl_loanxref as f on "
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "f.loan = h.loan"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "left outer join LMS_V11_YE_2011..nyl_extgeneralh as g on "
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "g.loan = h.loan and"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "    g.accounting_date = h.accounting_date"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "where t.loan_kind not like 'sf%' and"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "  a.investor_type = 'internal' and"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "      h.participant not like 'nylim%'"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "group by h.loan,f.loan_xref,h.participant,h.accounting_date,"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "case when g.port_loan = 'Y' then "
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "g.port_name"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "else"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "case when charindex(rtrim(t.loan), t.loan_name) != 0 then rtrim(substring(t.loan_name,1,charindex(rtrim(t.loan), t.loan_name)-1)) else t.loan_name end"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "    end,o.system_type,o.prop_type"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "order by h.loan,h.accounting_date"
    sSQL = sSQL & vbCrLf
    
    
    sSQL = sSQL & "select a.loan,a.loan_xref,l.loan_list,a.loan_name,a.participant,a.accounting_date,a.int_due_bal_p,a.int_coll_p,a.prepd_int_bal_p,a.accrd_int_bal_p,"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "       i.cash_date,p.imp_acctg_date,p.pint_coll_p,p.pint_due_bal_p,p.pprepd_int_bal_p,p.paccrd_int_bal_p,a.system_type,a.prop_type"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "from #allocation a"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "join #impairments i on"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "i.loan = a.loan"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "left outer join (select t.loan,t.participant,t.accounting_date  as [imp_acctg_date],m.accounting_date,m.cash_date,"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "                  t.int_due_bal_p as [pint_due_bal_p],t.int_coll_p as [pint_coll_p],"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "  t.prepd_int_bal_p as [pprepd_int_bal_p],t.accrd_int_bal_p as [paccrd_int_bal_p],t.system_type,t.prop_type"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & " from #allocation t"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & " join #impairments m on"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "  m.loan = t.loan and"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "                      m.participant = t.participant"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "     where"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & " case when year(m.cash_date) = (select year(pri_year_end) from accounts) and m.accounting_date = t.accounting_date then 1"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "                      when year(m.cash_date) < (select year(pri_year_end) from accounts) and t.accounting_date = (select pri2_year_end from accounts) then 1"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "                      else 0"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "                 end = 1) as p on"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "p.loan = a.loan and"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "p.participant = a.participant and"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "p.cash_date = i.cash_date and"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "p.prop_type = a.prop_type"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "-- the following lists the loans belonging to an xref number"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "left outer join (SELECT c1.loan_xref,c1.accounting_date,"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "  loan_list = substring((SELECT ( '| ' + rtrim(c2.loan) )"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "   FROM LMS_V11_YE_2011..nyl_loanxrefh c2"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "   WHERE c1.loan_xref = c2.loan_xref and"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "                             c1.accounting_date = c2.accounting_date"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "   GROUP BY "
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "  c2.loan_xref,c2.loan"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "   FOR XML PATH( '' )), 3, 1000 )"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "  FROM LMS_V11_YE_2011..nyl_loanxrefh c1"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "  GROUP BY c1.loan_xref,c1.accounting_date) as l on"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "a.loan_xref = l.loan_xref and"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "a.accounting_date = l.accounting_date"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "where a.accounting_date = (select pri_year_end from LMS_V11_YE_2011..accounts)"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "  and a.int_due_bal_p + a.int_coll_p + a.prepd_int_bal_p + a.accrd_int_bal_p != 0"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "group by "
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "a.loan,a.loan_xref,l.loan_list,a.loan_name,a.participant,a.accounting_date,a.int_due_bal_p,a.int_coll_p,a.prepd_int_bal_p,a.accrd_int_bal_p,"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "       i.cash_date,p.imp_acctg_date,p.pint_coll_p,p.pint_due_bal_p,p.pprepd_int_bal_p,p.paccrd_int_bal_p,a.system_type,a.prop_type"
    sSQL = sSQL & vbCrLf
    
    
    sSQL = sSQL & "drop table #impairments"
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "drop table #allocation"

   
    'create connection string
    sConnect = "Provider=SQLOLEDB;" & _
               "Data Source=" & ServerName & ";" & _
               "Initial Catalog=MS_IL;" & _
               "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

    Application.ScreenUpdating = True

End Sub

Thanks
 
just a quick point - do you always want to add a querytable to the worksshet (i.e. is it a new sheet each time) or do you want to work with teh existing one? (i.e. re-using a template / file)

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question
 
The sheet name would always be the same, but the data would, of course, always be refreshed.

Currently, the code deletes the sheet, creates it again, then adds the query.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top