Problem with Excel automation in access...

[wondermoose]

I have read several of the threads to try and fix the problem of Excel not closing in the Task Manager after an import and objExcel.quit command. Here is my code:
Private Sub cmdLoadData_Click()

Dim objExcel As Object 'Excel.Application
Dim tWB As Object 'Excel.Workbook 'temporary workbook (each in directory)
Dim tWS As Object 'Excel.Worksheet 'temporary worksheet variable
Dim Path As String 'string variable to hold the path to look through
Dim Local_Conn As ADODB.Connection
Dim FileName As String 'temporary filename string variable
Dim appExcel As Object
Dim count As Integer
Dim ColCount As Integer
Dim WSCount As Integer
Const ERR_APP_NOTRUNNING As Long = 429

On Error GoTo Exit_Sub

'Get Path Info for Databae
Set Local_Conn = CurrentProject.Connection

'***** Set folder to cycle through *****
Path = Left(Local_Conn.Properties("Data Source").Value, Len(Local_Conn.Properties("Data Source").Value) - 27)

'Call DBEngine.CompactDatabase(Path & "Data.mdb", Path & "Data.mdb")

FileName = Dir(Path & "*.xls", vbNormal) 'set first file's name to filename variable

If MsgBox("Please confirm", vbYesNo, "Confirm Setup") = vbNo Then GoTo Exit_Sub
If MsgBox("This will close any open Excel documents. Are you sure you want to continue?", vbYesNo, "Confirm Continue") = vbNo Then GoTo Exit_Sub

Do Until FileName = "" 'loop until all files have been parsed

'Confirm
If MsgBox("Do you want to process " & FileName & "?", vbYesNo, "Attention") = vbYes Then

On Error Resume Next

Set objExcel = GetObject(, "Excel.Application")

If Err = ERR_APP_NOTRUNNING Then
Set objExcel = CreateObject("Excel.Application")
End If

On Error GoTo Exit_Sub

'Open Current WB
Set tWB = objExcel.Workbooks.Open(FileName:=Path & FileName)
objExcel.Visible = False

'Set WS Count
count = 1

'SET Total WS Count
WSCount = tWB.Worksheets.count

For Each tWS In tWB.Worksheets 'loop through each sheet
'Update Status
Me.txtStatus = "Now processing sheet " & count & " of " & WSCount & " in file " & tWB.Name & "."
Me.Repaint

'Set Range for each of the established Worksheets
If tWB.Name = "1.XLS" Then
ColCount = 14
ElseIf tWB.Name = "2.XLS" Then
ColCount = 8
ElseIf tWB.Name = "3.XLS" Then
ColCount = 6
Else
ColCount = 1
End If

If count = 1 Then
On Error Resume Next
'Remove Table
DoCmd.DeleteObject acTable, Left(tWB.Name, Len(tWB.Name) - 4)
On Error GoTo Exit_Sub
End If

'Transfer Spreadsheet
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, Left(tWB.Name, Len(tWB.Name) - 4), Path & FileName, True, tWS.Name & "!A1:" & Chr(ColCount + 64) & tWS.UsedRange.Rows.count

'Count the number of sheets
count = count + 1

'Clear WS Memory
Set tWS = Nothing
Next 'tWS

Set objExcel = Nothing
Set tWB = Nothing

End If

FileName = Dir() 'set next file's name to FileName variable
Loop

If MsgBox("Do you want to generate the extract now?", vbYesNo, "Attention") = vbYes Then
Call cmdExport_Click
End If

Exit_Sub:
On Error Resume Next
objExcel.Quit
Set objExcel = Nothing
Set tWB = Nothing
Set tWS = Nothing

End Sub



Do I have a referencing problem or does anyone have a suggestion to get EXCEL.EXE to close in the task manager? Thanks.

 

[CautionMP]

wondermoose,
First guess is that you set the Excel object to nothing before you call Quit and since your exit routine has the error handlers turned off you never see the error.

...
Clear WS Memory
Set tWS = Nothing
Next 'tWS

[b][red]Set objExcel = Nothing[/red][/b]
Set tWB = Nothing

End If

FileName = Dir() 'set next file's name to FileName variable
Loop

If MsgBox("Do you want to generate the extract now?", vbYesNo, "Attention") = vbYes Then
Call cmdExport_Click
End If

Exit_Sub:
[b]On Error Resume Next
[red]objExcel.Quit[/red][/b]
Set objExcel = Nothing
...

Hope this helps,
CMP

[small]For the best results do what I'm thinking, not what I'm saying.[/small]
(GMT-07:00) Mountain Time (US & Canada)