Excel instance remains open

[David]

Hello

I am having an issue with the following code.
I have searched around for the answer but I cannot get anything I find to
work.
I know I must be missing something simple. When the code is run I still have
an instance of Excel open that holds up the future running of the code (plus
hogs system resource)
I thought that having
xlApp.Quit
set xlApp = Nothing
is supposed to get rid of that.
Please help.

David

Private Sub Import_Click()
Dim CheckDate As Date
Dim CheckFlightNoSheet, CheckFlightNoForm As String

Dim xlApp As Excel.Application
Dim strConnection As String

'On Error GoTo err_Import_Click

DoCmd.SetWarnings (WarningsOff)
DoCmd.OpenQuery "DeleteImport"

'Import file from HTM sheet
Set xlApp = CreateObject("Excel.Application")

xlApp.Workbooks.Add

strConnection =
"FINDER;file:///C:/Documents%20and%20Settings/David/My%20Documents/Work/Xfer/Flight_" & Me.FlightNoInput & ".htm"

With xlApp.ActiveSheet.QueryTables.Add(Connection:= _
strConnection _
, Destination:=Range("A1"))
.Name = "Flight_List"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

'Format Sheet
With xlApp
.Columns("B:B").Select
.Selection.TextToColumns Destination:=Range("B1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False,
FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
.Columns("F:F").Select
.Selection.TextToColumns Destination:=Range("F1"),
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(6, 1)),
TrailingMinusNumbers:=True
.ActiveWindow.SmallScroll Down:=-72
.Columns("G:G").Select
.Selection.Cut
.Columns("D").Select
.Selection.Insert Shift:=xlToRight
.Range("A1:A3").Select
.Selection.Cut Destination:=Range("B1:B3")
.Columns("A:A").Select
.Selection.Delete Shift:=xlToLeft
.Columns("E:R").Select
.Selection.Delete Shift:=xlToLeft
.Range("A7").Select
.ActiveCell.FormulaR1C1 = "LastName"
.Range("B7").Select
.ActiveCell.FormulaR1C1 = "FirstName"
.Range("C7").Select
.ActiveCell.FormulaR1C1 = "Destination"
.Range("D7").Select
.ActiveCell.FormulaR1C1 = "LocatorCode"
.Range("A1").Select
End With

xlApp.ActiveWorkbook.SaveAs Filename:= _
"C:/Documents and Settings/David/My
Documents/Work/Xfer/CurrentImport.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False

'xlApp.Visible = True

'Check that flight date on manifest and screen match
CheckDate = xlApp.ActiveSheet.Range("A2")
CheckFlightNoSheet = xlApp.ActiveSheet.Range("A1")
CheckFlightNoForm = "FLIGHT # " & Me.FlightNoInput

If CheckDate <> Me.FlightDate Then
MsgBox "The date does not match up. Please check, process
terminated.", vbCritical, "Information Error!"
GoTo exit_Import_Click
End If
If CheckFlightNoSheet <> CheckFlightNoForm Then
MsgBox "The flight number does not match up. Please check, process
terminated.", vbCritical, "Information Error!"
GoTo exit_Import_Click
End If


exit_Import_Click:
On Error GoTo 0
xlApp.Quit
Set xlApp = Nothing
DoCmd.SetWarnings (WarningsOn)

Exit Sub

err_Import_Click:
Select Case Err.Number

Case Else
MsgBox "Please Report! " & Err.Number & " (" & Err.Description & ")
in procedure Import_Click of VBA Document Form_Import", vbExclamation
Resume exit_Import_Click
End Select

End Sub

 

[Alex Dybenko]

Hi,
try to close workbook after last time you used it:
xlApp.ActiveWorkbook.Close

--
Best regards,
___________
Alex Dybenko (MVP)
http://accessblog.net
http://www.PointLtd.com

 

[David]

Hello Alex

That didn't work.
I think possibly that it has to do with this line:

With xlApp.ActiveSheet.QueryTables.Add(Connection:= strConnection _
, Destination:=Range("A1"))

Is there an extra connection opening with this remark?

David

 

[Alex Dybenko]

Hi David,
could be, but I am no familiar with QueryTables, try to ask in Excel group
also

--
Best regards,
___________
Alex Dybenko (MVP)
http://accessblog.net
http://www.PointLtd.com

 

[David]

I found an answer
It seems that everytime I used Destination:=Range("A1") (about 3 times in
the code) that it should have been qualified and this was holding the
instance open until access was closed.
It should be Destination:=xlApp.Range("A1")

David

 

[Alex Dybenko]

Thanks for update!

--
Best regards,
___________
Alex Dybenko (MVP)
http://accessblog.net
http://www.PointLtd.com

 

[Luis]

I had that problem with a Word process and i solved it using this code:

Sub TerminateWord()

Dim objWMIService, objProcess, colProcess
Dim strComputer, strList

strComputer = "."

Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")

Set colProcess = objWMIService.ExecQuery _
("Select * from Win32_Process")

For Each objProcess In colProcess
If StrComp(objProcess.Name, "WINWORD.EXE", 1) = 0 Then
objProcess.Terminate
End If
Next
End Sub


Hope this is useful.

 

[David]

Hello,

This is one of the options I looked at for solving my problem but I was sold
on the idea that the only reason this problem was persisting was due to my
sloppy programming. In the end this solution is a quick fix for a problem
that my code is constantly creating.
I was sold on the idea, as was pointed out many times in post that I read,
that finding the unqualified reference that held the instance open was the
better solution programatically.

Thanks you for your input
David