excel instance stays open
 

Hello,
I asked this in the access forum and I couldnt get an answer that worked.
Just wondering if you guys know because its about excel automation

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

PS I think that it is the following line that is causing the extra instance;
With xlApp.ActiveSheet.QueryTables.Add(Connection:= _
strConnection _
, Destination:=Range("A1"))



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: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

excel instance stays open
 

I could be wrong, but it looks like you created a workbook in the Excel
instance and left it open while trying to quit the application. If I am
right, then it will not exit the application while that workbook is open.

"David" wrote:

Hello,
I asked this in the access forum and I couldnt get an answer that worked.
Just wondering if you guys know because its about excel automation

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

PS I think that it is the following line that is causing the extra instance;
With xlApp.ActiveSheet.QueryTables.Add(Connection:= _
strConnection _
, Destination:=Range("A1"))



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: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

excel instance stays open
 

Closing the workbook did not help however 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

"JLGWhiz" wrote:

I could be wrong, but it looks like you created a workbook in the Excel
instance and left it open while trying to quit the application. If I am
right, then it will not exit the application while that workbook is open.

"David" wrote:

Hello,
I asked this in the access forum and I couldnt get an answer that worked.
Just wondering if you guys know because its about excel automation

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

PS I think that it is the following line that is causing the extra instance;
With xlApp.ActiveSheet.QueryTables.Add(Connection:= _
strConnection _
, Destination:=Range("A1"))



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: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

excel instance stays open
 

Thanks for posting back with the solution.

"David" wrote:

Closing the workbook did not help however 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

"JLGWhiz" wrote:

I could be wrong, but it looks like you created a workbook in the Excel
instance and left it open while trying to quit the application. If I am
right, then it will not exit the application while that workbook is open.

"David" wrote:

Hello,
I asked this in the access forum and I couldnt get an answer that worked.
Just wondering if you guys know because its about excel automation

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

PS I think that it is the following line that is causing the extra instance;
With xlApp.ActiveSheet.QueryTables.Add(Connection:= _
strConnection _
, Destination:=Range("A1"))



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: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