Kill all objects 1

[cmz21]

Hello,
I have a vba macro which uses access queries to create an excel workbook. Each Excel workbook is created from a command button on an access form. After I create the workbook, save it, and close via the macro, I still have an instance of excel running in the background. The code I use is:

xlApp.Quit
Set xlBook = Nothing
Set xlSheet1 = Nothing
Set xlSheet2 = Nothing
Set xlSheet3 = Nothing
Set xlSheet 4 = Nothing
Set xlSheet5 = Nothing
Set xlApp = Nothing

As far as I can tell, this takes care of all of my objects, but I cannot get rid of taht instance of Excel until I also close Access.
Is there a way to find out which objects are keeping that background excel running?

Any thoughts would be appreciated.

Thanks
cmz

 

[PHV]

Have you xlBook.Close before xlApp.Quit ?

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[cmz21]

No, I haven't.
I will give it a whirl.

Thanks
cmz

 

[cmz21]

That didn't seem to work. I still had to close the database before the instance of excel closed.

 

[PHV]

So, double check that ALL the excel objects in your code are FULLY qualified.
The usual culprit is the use of an unqualified Selection.

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[cmz21]

What exactly is meant by saying that all objects are fully qualified?
I have option explicit in my code, which I thought meant that the code will not run unless everything is fully qualified. Am I misunderstanding something?

Thanks for any thoughts.

cmz

 

[PHV]

For example replace this:
Selection.Clear
By this:
xlApp.Selection.Clear

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[cmz21]

Here is my code.....could someone please help me. I cannot seem to get all objects cleared. After I create the workbook, I cannot open it until I close entirely out of Access.

Thanks




Function transferrecordset()
Dim strSQL_Detail As String
Dim rsSQL_Detail As Recordset
Dim EndCell

Dim myfile

'Delete the file if it already exists
myfile = Dir("C:\Path\and\filname" & Format(Now(), "MMMM YYYY") & "\filename " & Format(Now(), "MMMM YYYY") & ".xls")
If myfile > "" Then Kill ("C:\Path\and\filname" & Format(Now(), "MMMM YYYY") & "\filenam " & Format(Now(), "MMMM YYYY") & ".xls")

'Start SQL Queries****************************************************************************
''BasicLife Detail Query
strSQL_Detail = "SQL Statement"



Set rsSQL_Detail = CurrentDb.OpenRecordset(strSQL_Detail)

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets.Add

xlSheet.Name = ("Sheet1 " & Format(Now(), "mm-yy"))

EndCell = CVar(rsSQL_Detail.RecordCount + 2)

xlSheet.Range("A3").CopyFromRecordset rsSQL_Detail

'Format the Worksheet*************************************************************************
With xlSheet
.Range("A1").Value = Now()
.Range("A1").Font.Bold = True
.Range("A1").Font.Size = 16
.Range("A2").Value = "Last Name"
.Range("B2").Value = "First Name"
.Range("C2").Value = "field3"
.Range("D2").Value = "field4"
.Range("A2:K2").Font.Bold = True
.Range("A2:K2").Font.Underline = True
.Range("A2:K2").Interior.ColorIndex = 15
.Range("A2:K2").Interior.Pattern = xlSolid
.Range("A2:K2").Interior.PatternColorIndex = xlAutomatic
.Range("A2:K2").Borders.LineStyle = xlContinuous
.Range("A2:K2").Borders.Weight = xlMedium
.Range("A2:K2").Borders(xlInsideVertical).LineStyle = xlNone
.Range("A2:K2").Borders(xlInsideHorizontal).LineStyle = xlNone

End With

Range("A1").Sort Key1:=Range("D3"), Order1:=xlAscending, Key2:=Range("A3") _
, Order2:=xlAscending, Key3:=Range("B3"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Subtotal GroupBy:=4, Function:=xlCount, TotalList:=Array(3), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
xlSheet.Columns("A:K").EntireColumn.AutoFit

'Create new folder (if necessary) and Save the workbook to it
If Dir("C:\Path\and\filname " & Format(Now(), "MMMM YYYY"), vbDirectory) = "" Then
MkDir "C:\Path\and\filname " & Format(Now(), "MMMM YYYY")
End If

xlBook.SaveAs "C:\Path\and\filname " & Format(Now(), "MMMM YYYY") & "\filename" & Format(Now(), "MMMM YYYY") & ".xls"
'xlBook.SaveAs "C:\Path\and\filname " & Format(Now(), "MMMM YYYY") & ".xls"

'Delete excess sheets
With xlApp
.DisplayAlerts = False
.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
.ActiveWindow.SelectedSheets.Delete
End With

xlApp.Visible = True

xlApp.ActiveWorkbook.Save

'Kill objects
xlBook.Close
xlApp.Quit
Set EndCell = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing
Set xlApp = Nothing

End Function

 

[PHV]

Replace this:
Range("A1").Sort Key1:=Range("D3"), Order1:=xlAscending, Key2:=Range("A3") _
, Order2:=xlAscending, Key3:=Range("B3"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Subtotal GroupBy:=4, Function:=xlCount, TotalList:=Array(3), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
By this:
[highlight]xlSheet.[/highlight]Range("A1").Sort Key1:=[highlight]xlSheet.[/highlight]Range("D3"), Order1:=xlAscending, Key2:=[highlight]xlSheet.[/highlight]Range("A3") _
, Order2:=xlAscending, Key3:=[highlight]xlSheet.[/highlight]Range("B3"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
[highlight]xlSheet.[/highlight]Range("A1").Subtotal GroupBy:=4, Function:=xlCount, TotalList:=Array(3), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[cmz21]

That's the ticket.....
Thanks Alot


cmz