Can't get Excel to close

[nsp27]

This code runs fine but it won't close excel. I'm fairly new to manipulating excel from Access using VBA.

Any help would be appreciated.

Sub PullInData()
On Error Resume Next
 
Dim strCheck As String
Dim strCursor As String
Dim lngRowPrevious As Long
Dim lngCarrierRow As Long
Dim lngRow As Long
Dim lngAddress As Long
Dim rng As Range
Dim rngCarrier As Range
Dim strLastCarrier As String
Dim strDelete As String
Dim strCarrier As String
Dim strRange As String
Dim strMsg As String
Dim x As Integer
Dim objXLTemp As Object
Dim objWBtemp As Object
DoCmd.SetWarnings False
Const strTieOutTempPath As String = "C:\RNETTDTieOut\BaseFiles\TieOutTemp.xls"
Const strRNETFilePath As String = "C:\RNETTDTieOut\BaseFiles\i000#accepted_items#age_st_fncurr.xls"
'Const strTieOutTempPath As String = C:\TieOutTemp.xls"
'Const strRNETFilePath As String = "C:\Accepteditems.xls"
Const strTableName As String = "TempTieOut"
If FileExists(strRNETFilePath) Then
    FileCopy strRNETFilePath, strTieOutTempPath
End If
 
Set objXLTemp = GetObject(, "Excel.Application")
If Err.Number > 0 Then  'Excel was not open
    Set objXLTemp = New Excel.Application
End If
 
'Gets the temporary spreadsheet ready so it can be linked to Access and worked on
'=====================================================================================
objXLTemp.Workbooks.Open (strTieOutTempPath)
Set objWBtemp = objXLTemp.ActiveWorkbook
'objXLTemp.Visible = True
strCheck = objXLTemp.Sheets(1).Cells(1, 1).Value
 
    If strCheck = "Best Buy" Then
        For x = 1 To 6
            objXLTemp.Application.Selection.EntireRow.Delete
        Next x
    End If
 
With objXLTemp
    .Sheets(1).Range("A1").Value = "Subtotal"
    .Sheets(1).Range("B1").Value = "Status"
    .Sheets(1).Range("C1").Value = "Carrier"
    .Sheets(1).Range("D1").Value = "State"
    .Sheets(1).Range("E1").Value = "Balance"
    .Sheets(1).Range("F1").Value = "Dollars"
    .Sheets(1).Range("G1").Value = "D/C"
    .Sheets(1).Range("H1").Value = "TotalItems"
    .Sheets(1).Range("I1").Value = "Units"
    .Sheets(1).Range("J1").Value = "B/C"
 
    Set rng = .Sheets(1).Range("D1:D100").Find(What:="Carrier", _
                        LookIn:=xlFormulas, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
    If Not rng Is Nothing Then
        objXLTemp.Goto rng, True
    Else
        MsgBox "Carrier line not found, something is wrong with the file...."
        GoTo getout
    End If
 
    lngAddress = (ActiveCell.Row - 2) / 3
    strCursor = "D4"
    strCarrier = .Sheets(1).Range(strCursor).Value
    strLastCarrier = "B1:B100"
    lngRowPrevious = 1
 
    For x = 1 To lngAddress
 
        Set rngCarrier = .Sheets(1).Range(strLastCarrier).Find(What:="Carrier", _
                        LookIn:=xlFormulas, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
 
        lngRow = rngCarrier.Row
 
        strCursor = "D" & lngRow
        .Sheets(1).Range(strCursor).Copy
        strRange = "C" & (lngRowPrevious + 1) & ":C" & (lngRow - 1) & ""
        .Sheets(1).Range(strRange).Select
        .ActiveSheet.Paste
        strLastCarrier = "B" & (lngRow + 1) & ":B100"
        lngRowPrevious = lngRow
    Next x
 
    Set rng = Nothing
    Set rng = .Sheets(1).Range("A1:A200").Find(What:="SUMMARY TOTAL", _
                        LookIn:=xlFormulas, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
    If Not rng Is Nothing Then
        objXLTemp.Goto rng, True
        strDelete = ActiveCell.Row & ":" & ActiveCell.Row + 10
        .Sheets(1).Rows(strDelete).Select
        Selection.EntireRow.Delete
 
    Else
        'No need to trap error if there's no line with Summary Total
    End If
End With
'Creates the link to the new TempTieOut spreadsheet
    If FileExists(strTieOutTempPath) Then
        If TableExists(strTableName) Then
            DoCmd.DeleteObject acTable, strTableName
        End If
    DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel12, strTableName, strTieOutTempPath, True
    Else
        strMsg = MsgBox("The File " & strTieOutTempPath & " is missing, exiting code...", vbOKOnly, "MISSING FILE")
        GoTo getout
    End If
 
If FileExists(strTieOutTempPath) Then
    If TableExists(strTableName) Then
        DoCmd.DeleteObject acTable, strTableName
    End If
DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel12, strTableName, strTieOutTempPath, True
Else
    strMsg = MsgBox("The File " & strTieOutTempPath & " is missing, exiting code...", vbOKOnly, "MISSING FILE")
    GoTo getout
End If
 
DoCmd.RunSQL ("Delete *.* From tReconnet")
DoCmd.OpenQuery "qAppendtoReconnet"
DoCmd.OpenQuery "qUpdateReconetState"
getout:
objXLTemp.DisplayAlerts False
objWBtemp.Save
objXLTemp.DisplayAlerts True
objWBtemp.Close
objXLTemp.Quit
Set objXLTemp = Nothing
Set objWBtemp = Nothing
DoCmd.SetWarnings True
End Sub

 

[mdlueck]

This code runs fine but it won't close excel.

getout:
objXLTemp.DisplayAlerts False
objWBtemp.Save
objXLTemp.DisplayAlerts True
objWBtemp.Close
objXLTemp.Quit
Set objXLTemp = Nothing
Set objWBtemp = Nothing
DoCmd.SetWarnings True
End Sub

I have a bit different syntax to save / close / exit Excel...

Public Sub SaveExitExcel()
On Error GoTo Err_SaveExitExcel

  'Log the current operation to the StatusBar
  Call SysCmd(acSysCmdSetStatus, "Saving Data and Exiting Excel, Please Wait...")
  DoEvents

  'Save the Workbook
  objExcelApp.ActiveWorkbook.Save

  'Bye bye!
  objExcelApp.Quit

Exit_SaveExitExcel:
  Set objExcelWks = Nothing
  Set objExcelWbk = Nothing
  Set objExcelApp = Nothing

  Exit Sub

Err_SaveExitExcel:
  Call errorhandler_MsgBox("Class: " & TypeName(Me) & ", Subroutine: SaveExitExcel()")
  'Disable further error handling, so that the code which is using this object will handle the error
  On Error GoTo 0
  'Raise the error to the caller program
  Err.Raise Number:=vbObjectError + 1032, _
            Source:="Class: " & TypeName(Me) & ", Subroutine: SaveExitExcel()", _
            Description:="Failed to SaveExitExcel()"
  Resume Exit_SaveExitExcel

End Sub