Can't close excel instance after excel automation 1

[mikeH321]

I hope I'm posting this in the right forum, I've never really used on of these forums before. I have the following code that I am using to move date from MS Access to MS Excel. The code itself work flawlessly except the after closing there is still an instance of Excel hanging around in my task manager. I believe the problem is related to the fact that the row I activated to use the .freezePanes is still activated when I close the application. If I remove the adding of the image and the freezePane there is no Excel instances left. If I put them back in then it hangs there. I've scoured the net for about a week looking for my error and I've yet to find it. Any suggestions would be appriciation.

Code Starts here:

Sub ecMAP()
On Error GoTo ErrHandler

' Excel object variables
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim sOutput As String

Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim sSQL As String
Dim lRecords As Long
Dim iRow As Integer
Dim iCol As Integer
Dim iFld As Integer
Dim highLight As Boolean
Dim sheetsPerBook As Integer

'CONSTANTS
Const aTab As Byte = 1
Const aStartRow As Byte = 6
Const aStartColumn As Byte = 1

' set to break on all errors
Application.SetOption "Error Trapping", 0

' GENERATING OUTPUT FILE NAME
If formdate("S", 8) = formdate("E", 8) Then

sOutput = "S:\HWYREPORTS\COL\Accounts\M\Mariani\Mariani Accessorials " & Format(fdate(formdate("S", 8)), "mm-dd-yy") & ".xls"

Else

sOutput = "S:\HWYREPORTS\COL\Accounts\M\Mariani\Mariani Accessorials " & Format(fdate(formdate("S", 8)), "mm-dd-yy") & " through " & Format(fdate(formdate("E", 8)), "mm-dd-yy") & ".xls"

End If

If Dir(sOutput) <> "" Then Kill sOutput

' Create the Excel Applicaiton, Workbook and Worksheet and Database object
Set appExcel = New Excel.Application
sheetsPerBook = appExcel.SheetsInNewWorkbook
appExcel.SheetsInNewWorkbook = 1
Set wbk = appExcel.Workbooks.Add
appExcel.SheetsInNewWorkbook = sheetsPerBook
Set wks = wbk.Worksheets(aTab)
Set dbs = CurrentDb
sSQL = "select * from MAPqryExport"
Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)

'ADDING LOGO TO EXCEL FILE

wks.Pictures.Insert("S:\HWYREPORTS\Libraries\Logos\mariani.GIF").Select
Selection.ShapeRange.Height = 49.5
Selection.ShapeRange.Width = 235.5

With Selection
.Placement = xlFreeFloating
.PrintObject = True
End With

wks.Rows("6").Activate
ActiveWindow.FreezePanes = True

' ADDING COLUMN HEADERS TO EXCEL FILE

With wks

iCol = aStartColumn
iRow = (aStartRow - 1)

If Not rst.BOF Then rst.MoveFirst

iFld = 0
lRecords = lRecords + 1


For iCol = aStartColumn To aStartColumn + (rst.Fields.Count - 1)

wks.Cells(iRow, iCol) = rst.Fields(iFld).Name
wks.Cells(iRow, iCol).Interior.ColorIndex = 1
wks.Cells(iRow, iCol).Font.ColorIndex = 2
wks.Cells(iRow, iCol).Font.Bold = True

iFld = iFld + 1

Next

iRow = iRow + 1
rst.MoveNext

End With

' ADDING INFO TO EXCEL FILE
iCol = aStartColumn
iRow = aStartRow
highLight = False

With wks

If Not rst.BOF Then rst.MoveFirst
Do Until rst.EOF
iFld = 0
lRecords = lRecords + 1

For iCol = aStartColumn To aStartColumn + (rst.Fields.Count - 1)

wks.Cells(iRow, iCol) = rst.Fields(iFld)
wks.Cells(iRow, iCol).NumberFormat = "$0.00"

'If highLight = True Then

'wks.Cells(iRow, iCol).Interior.ColorIndex = 35

'End If

iFld = iFld + 1

Next

iRow = iRow + 1
rst.MoveNext

'If highLight = False Then

'highLight = True

'Else

'highLight = False
'End If

Loop

End With

'ADDING TOTALS

Dim columnCount As Integer
columnCount = 3 'starting column for totals

With wks

wks.Cells(aStartRow + rst.RecordCount + 1, aStartColumn + 1) = "Totals:"
wks.Cells(aStartRow + rst.RecordCount + 1, aStartColumn + 1).Font.Bold = True
wks.Cells(aStartRow + rst.RecordCount + 1, aStartColumn + 1).Font.ColorIndex = 2
wks.Cells(aStartRow + rst.RecordCount + 1, aStartColumn + 1).Interior.ColorIndex = 1

Do While columnCount <= 10

wks.Cells(aStartRow + rst.RecordCount + 1, columnCount).Formula = "=SUM(R[-" & rst.RecordCount + 1 & "]C:R[-1]C)"
wks.Cells(aStartRow + rst.RecordCount + 1, columnCount).Font.Bold = True
wks.Cells(aStartRow + rst.RecordCount + 1, columnCount).Font.ColorIndex = 2
wks.Cells(aStartRow + rst.RecordCount + 1, columnCount).Interior.ColorIndex = 1

columnCount = columnCount + 1

Loop

End With

'AUTOFITTING COLUMNS

With wks

wks.Columns("A:A").EntireColumn.AutoFit
wks.Columns("B:B").EntireColumn.AutoFit
wks.Columns("C:C").EntireColumn.AutoFit
wks.Columns("D").EntireColumn.AutoFit
wks.Columns("E:E").EntireColumn.AutoFit
wks.Columns("F:F").EntireColumn.AutoFit
wks.Columns("G:G").EntireColumn.AutoFit
wks.Columns("H:H").EntireColumn.AutoFit
wks.Columns("I:I").EntireColumn.AutoFit
wks.Columns("J:J").EntireColumn.AutoFit
wks.Columns("K:K").EntireColumn.AutoFit
wks.Columns("L:L").EntireColumn.AutoFit
wks.Columns("M:M").EntireColumn.AutoFit
wks.Columns("N:N").EntireColumn.AutoFit
wks.Columns("O:O").EntireColumn.AutoFit
wks.Columns("P").EntireColumn.AutoFit
wks.Columns("Q:Q").EntireColumn.AutoFit
wks.Columns("R:R").EntireColumn.AutoFit

End With

With wbk

'NAMING TAB
wks.Select
wks.Name = "Mariani Accessorials"

End With

With wks

.PageSetup.Zoom = False
.PageSetup.CenterHeader = "Mariani Accessorial Report"
.PageSetup.CenterFooter = "Page &p"

End With

'CLOSING AND SAVING NEW FILES

Set wks = Nothing

wbk.SaveAs FileName:=sOutput, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False

wbk.Close SaveChanges:=False

Set wbk = Nothing

appExcel.Quit

Set appExcel = Nothing

'Call AutoEmailAll("SPNEM - tblDistList", "Attached is the SP News Exception Report. If the report is blank, there were no exceptions entered.", "SP News Exception Memo Report", sOutput)

ExitProcedure:
Exit Sub

ErrHandler:
Select Case Err.Number
Case Else
Call UnexpectedError(Err.Number, "ecSPNEM: " _
& Err.Description, Err.Source, _
Err.HelpFile, Err.HelpContext)
Resume ExitProcedure
Resume
End Select


End Sub

 

[Andrzejek]

Not that I have a solution to your problem, but instead of

 'AUTOFITTING COLUMNS
   With wks
        wks.Columns("A:A").EntireColumn.AutoFit
        wks.Columns("B:B").EntireColumn.AutoFit
        wks.Columns("C:C").EntireColumn.AutoFit
        wks.Columns("D:D").EntireColumn.AutoFit
        wks.Columns("E:E").EntireColumn.AutoFit
        wks.Columns("F:F").EntireColumn.AutoFit
        wks.Columns("G:G").EntireColumn.AutoFit
        wks.Columns("H:H").EntireColumn.AutoFit
        wks.Columns("I:I").EntireColumn.AutoFit
        wks.Columns("J:J").EntireColumn.AutoFit
        wks.Columns("K:K").EntireColumn.AutoFit
        wks.Columns("L:L").EntireColumn.AutoFit
        wks.Columns("M:M").EntireColumn.AutoFit
        wks.Columns("N:N").EntireColumn.AutoFit
        wks.Columns("O:O").EntireColumn.AutoFit
        wks.Columns("P:P").EntireColumn.AutoFit
        wks.Columns("Q:Q").EntireColumn.AutoFit
        wks.Columns("R:R").EntireColumn.AutoFit
    End With

(BTW, With statement is not needed here because it does not do anything.)

You could just

wks.Columns("A:R").EntireColumn.AutoFit

---- Andy

 

[HughLerwill]

mikeH321,

Offering no solution either (yet :~})but further to Andy's;

You seem to be going to the trouble of setting up With blocks but then you do not make use of them.

e.g. You do not need the wks prefix when you are within a With wks block as in;

With wks

iCol = aStartColumn
iRow = (aStartRow - 1)

If Not rst.BOF Then rst.MoveFirst

iFld = 0
lRecords = lRecords + 1


For iCol = aStartColumn To aStartColumn + (rst.Fields.Count - 1)

*wks.Cells(iRow, iCol) = rst.Fields(iFld).Name
*wks.Cells(iRow, iCol).Interior.ColorIndex = 1
*wks.Cells(iRow, iCol).Font.ColorIndex = 2
*wks.Cells(iRow, iCol).Font.Bold = True

iFld = iFld + 1

Next

iRow = iRow + 1
rst.MoveNext

End With

My stars highlight the lines in question, delete the wks so they begin with the the '.'
Address similar stuff if any.

regards Hugh

 

[mikeH321]

Thanks guys for the feed back... I've removed the redundant wks.'s from my code and simplified my autofitting of the columns. Still can't figure out why the Excel instance is sticking around though. One additional thing I figured out though... if I close Access after running the code the Excel instance dies.

 

[HughLerwill]

mikeH321,

You 'Set appExcel = Nothing';have you tried doing that for all the other objects in your code. e.g. wks

I suspect the symptoms you describe are due to an object (you are using) remaining in scope after you Exit or End the Sub. I seem to remember there is stuff on this in MSKB and in an FAQ in this forum, if I can find them I'll come back. Another symtom may be that the routine will run the first time but fails on the second try(same session); Are you getting that?

regards Hugh,

 

[HughLerwill]

mike,

Here's the MSKB ref I was thinking of;

http://support.microsoft.com/kb/q178510/

regards Hugh,

 

[HughLerwill]

mike,

ref my <<e.g. wks>>, sorry you are doing that but how about rst and dbs?

regards Hugh,

 

[HughLerwill]

Mike,

There is an unqualified reference!

Try AppExcel.ActiveWindow.FreezePanes = True

Hugh,

 

[HughLerwill]

Mike,

'Selection' may also be unqualified in your;

wks.Pictures.Insert("S:\HWYREPORTS\Libraries\Logos\mariani.GIF").Select
Selection.ShapeRange.Height = 49.5
Selection.ShapeRange.Width = 235.5

With Selection
.Placement = xlFreeFloating
.PrintObject = True
End With

Unless it is preceded with an AppExcel. or a wkb. or a wks. (I'm not sure which).

Anyway you should not need to use Selection and it may be better to try and avoid it with;

With wks.Pictures.Insert("S:\HWYREPORTS\Libraries\Logos\mariani.GIF")
.ShapeRange.Height = 49.5
.ShapeRange.Width = 235.5

.Placement = xlFreeFloating
.PrintObject = True
End With

regards Hugh,

 

[mikeH321]

Thanks Hugh, I used all of your suggestions about qualifying some of my statements and it worked perfectly.

 

[HughLerwill]

Mike,

Thanks for the star and welcome to the forum.

regards Hugh,