Excel.exe still running......

[anu]

Sorry for cross posting,but I reallu need help with this
one. My problem is I dont know how to release an instance
of execl when I get an error. (I can see the excel.exe
still running in the task manager)

I have a function in VB .This cretaes an excel app and
copies xl files from a temp folder into another workbook.
I encounter a problem after it has added a certain number
of sheets but not all. I get aotomation error and at this
point i want to release the excel instance byt it doesnot
happen....
Here is the code:

If FSO.FolderExists(sFolder) Then
If XLApp Is Nothing Then
Set XLApp = CreateObject("Excel.application")
Else
XLApp.quit
Set XLApp = Nothing
Set XLApp = CreateObject("Excel.application")
End If
XLApp.DisplayAlerts = False
For Each FL In FSO.GetFolder(sFolder).Files
If UCase(Right(FL.Name, 4)) = ".XLS" Then
Retry:
If XLWB2 Is Nothing And X <> 2 Then
Set XLWB2 = XLApp.Workbooks.Open
(FileName:=FL.Path, ignoreReadOnlyRecommended:=True,
ReadOnly:=False)
DoEvents
X = 1
Else
Set XLWB1 = XLApp.Workbooks.Open
(FileName:=FL.Path, ignoreReadOnlyRecommended:=True,
ReadOnly:=False)
DoEvents
X = 2
End If

If X = 1 Then
XLWB2.sheets(1).Cells.Select
XLWB2.sheets
(1).Cells.EntireColumn.AutoFit
XLWB2.sheets(1).Name = Left(Replace
(Left(FL.Name, Len(FL.Name) - 4), " ", ""), 30)
XLWB2.sheets(1).Range("a1").Select
XLWB2.SaveAs sPPname
intSheetCount = 1
Else
If intSheetCount = 1 Then
Set XLWB2 = XLApp.Workbooks.Open
(FileName:=sPPname, ignoreReadOnlyRecommended:=True,
ReadOnly:=False)
DoEvents
End If
XLWB1.sheets(1).Activate
XLWB1.sheets(1).Cells.Select
XLWB1.sheets
(1).Cells.EntireColumn.AutoFit
XLWB1.sheets(1).Name = Left(Replace
(Left(FL.Name, Len(FL.Name) - 4), " ", ""), 30)
XLWB1.sheets(1).Range("a1").Select
DoEvents
XLWB1.sheets(1).Copy
before:=XLWB2.sheets(1)
DoEvents
On Error Resume Next

If Err.Number = -2147417851 Then
Debug.Print Err.Number & ":" &
Err.Description
Err.Clear

XLWB2.Save
XLWB2.sheets(1).Delete

Set XLWB2 = Nothing
Set XLWB1 = Nothing
On Error Resume Next ' Defer
error trapping.
Set XLApp = GetObject
(, "Excel.Application")
If Err.Number = 0 Then
XLApp.Application.quit
Set XLApp = Nothing
Else
Err.Clear ' Clear Err object
in case error occurred.
End If
XLApp.DisplayAlerts = False
Set XLWB2 = XLApp.Workbooks.Open
(FileName:=sPPname, ignoreReadOnlyRecommended:=True,
ReadOnly:=False)
DoEvents
GoTo Retry
End If
XLWB2.Save
XLWB1.Close False
Set XLWB1 = Nothing
intSheetCount = intSheetCount + 1
End If
End If
Next FL
End If



Thanks
Anu
..