D
David
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").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
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").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