Excel not closing vba

When Application.Quit is encountered in a subroutine,
it will only stay in memory and continue to run lines under it
and will actually quit until it encounters a «Exit Sub».
When the normal «End Sub» at the primary level is encountered,
it will then also close Excel. But say if the workbook is somehow
closed before reaching the «Exit Sub», «End» or «End Sub» line, then
Excel will not close.

Solution is to create a Public variable called ToQuitNow
with initial False value
and change it to True where you want Excel to quit.
and test right after to see if it is true, then return to previous Sub level
by «Exit Sub» or «End» to quit right away,
and do the same at every subrountine level where
it is expected to return from the deeper subroutine.
When it gets back to the primary level,
then a final «Exit Sub» will actually terminates Excel.
If you do not want Excel to ask for saving changes made,
add line «ThisWorkbook.Saved = True» right after Application.Quit,
or before the final «Exit Sub» at the Primary level
and Excel will quit without saving.

Try the following test below, just run «Test»

Public ToQuitNow As Boolean

Sub Test()

ToQuitNow = False ' initialize with False value
Call SecondSub
MsgBox ("Primary level here. Back from SecondSub")
If ToQuitNow = True Then
    Exit Sub 'will actually quit Excel now if True
End If
MsgBox ("This line will not run if ToQuitNow is True")
End Sub

Sub SecondSub()

MsgBox ("SecondSub here")
Call ThirdSub
MsgBox ("SecondSub here. Back from ThirdSub")
If ToQuitNow = True Then
    Exit Sub ' will return to Main level if True
End If
MsgBox ("This line from SecondSub will not run if ToQuitNow is True")
End Sub

Sub ThirdSub()

MsgBox ("ThirdSub here")
Call FourthSub
MsgBox ("ThirdSub here. Back from FourthSub")
If ToQuitNow = True Then
    Exit Sub ' will return to SecondSub if True
End If
MsgBox ("This line from ThirdSub will not run if ToQuitNow is True")
End Sub

Sub FourthSub()

MsgBox ("FourthSub here")
Application.Quit
ThisWorkbook.Saved = True ' Excel will think changes already saved _
and will quit without saving
ToQuitNow = True ' activate Quit
If ToQuitNow = True Then
    MsgBox ("Quit command executed in FourthSub")
    Exit Sub ' will return to ThirdSub if True
    'Can also put in End in above line to quit right away

End If
MsgBox ("This line from FourthSub will not run if ToQuitNow is True.")
End Sub

Источник
  • Remove From My Forums

  • Question

  • I am using window 7, Excel 2010, Access 2010.  I have a routine (running in Access 2010) that opens an excel file, reads in the data, then closes the excel file.

    Everything work fine except for closing the excel file.  If I watch Windows Task Manager EXCEL.EXE does not terminate.

    Below is a snipit of code that duplicates the problem I am seeing.  How can I close and terminated the EXCEL? 

    The routine is called multiple times.  The first time through the process EXCEL does not close.   The second time a second copy of EXCEL is created and at the end of the routine it does close, but the first occurance is still there. 
    If I press the VBA reset (stop) button excel will then terminate.

    Function TestOpenCloseExcel(sExcelFile
    As     String) As
    Integer

                   

      Dim ExcelWorkBook 
    As     Workbook
      Dim iResult As
    Integer
      Dim ExcelApp As
    Object

     
      On Error
    GoTo     ErrorTrap

      Debug.Print «Open»
      Set ExcelApp = CreateObject(«Excel.Application»)
      Set ExcelWorkBook = ExcelApp.Workbooks.Open(sExcelFile)

      Debug.Print «Close»

     
      ExcelWorkBook.Close
      Set ExcelWorkBook =
    Nothing
      ExcelApp.Quit ‘this line terminates the process
      Set ExcelApp = Nothing

     
      Exit Function

    ErrorTrap:
      Debug.Print «(« & Err.number &
    «) «     & Err.Description
    End Function

Answers

  • mathew,

    The problem most likely lies elsewhere.

    Look for *anywhere* in your app where you use any Excel objects or methods in conjunction with a WITH-block of code.

    It is a commonly known issue that Unless your code explicitly declares and clears automation-based object variables used as the object of a with-block (With…End With syntax), those objects can get stuck in memory as «orhpaned» com objects. This will then
    prevent the release of their automation server classes (since a consitiuent object still has a non-zero COM reference count). This will present as the symptom you are observing: Excel won’t close despite the call to .Quit.

    Automation-based  object instances should ALL be used like this:

    Dim objTemp as (Object/Excel.range/whatever)

    set objTemp = (whatever)
    With ObjTemp
      ‘do stuff here
    End With
    set objTemp = Nothing

    what you should NOT be doing is this:

    With objExclApp.worksheets(1).range(«myNamedrange»)
      ‘do stuff
    End With

    THIS is the sort of thing that can leave phantom references for a range object (if not also a worksheet object) stuck in memory because they don’t get cleaned up properly.

    Examine the rest of your code for anything that fits this pattern and explicitly declare and clear appropriate variables for those object references. This may well eliminate your issue.

    Mark Burns, MCAD, MCP
    Sr. Microsoft Access Analyst/Developer
    Manager LinkedIn.Com community: Professional Microsoft Access Developers Network (PMADN)

    • Marked as answer by

      Tuesday, February 8, 2011 9:14 AM

  • As I understand this the piece of code I’ve provided here
    http://social.msdn.microsoft.com/Forums/en-US/accessdev/thread/f107ba63-2895-4590-872d-4c37bdd8111c

    As I said before I had tested it and hadn’t faced this error. Just for my interest I’ve modified this func a little to run it more than once. I opened Task Manager and was watching on EXCEL.EXE process. It opens and closes properly within every iteration
    of the loop and there is no such a behaviour you are describing above.

    Maybe this function in your full code is being called from another function/sub and the real reason is there? Try to terminate all EXCEL.EXE before testing and then run exactly this function 3-5 times. If there is no problem look at the another place in
    your code which can generate this issue.

    Andrey V Artemyev | Saint-Petersburg, Russia

    • Marked as answer by
      Bessie Zhao
      Tuesday, February 8, 2011 9:14 AM

  • CNC_Matthew:

    In the code you have posted, you have not done the following, but I wonder whether, in the code you are actually running:

    1. you have declared the variable, ExcelApp, in the General Declarations Section (at the top) of your module; and
    2. you are not setting ExcelApp to Nothing (at least between successive calls to the function).

    The above would account for the behaviour you are experiencing.

    In the following demo, notice that it is only when the variable ExcelApp is set to Nothing or when the ExcelApp variable goes out of scope that the Excel process finally disappears from the Windows Task Manager. 
    The Excel process does not disappear from Task Manager when you execute Excel’s Quit command.

    Private ExcelApp As Excel.Application


Function TestOpenCloseExcel(sExcelFile As String) As Integer
    
 Dim ExcelWorkBook As Excel.Workbook
 Dim iResult As Integer
 
 On Error GoTo Error_TestOpenCloseExcel

 Debug.Print "Start Excel"
 Set ExcelApp = CreateObject("Excel.Application")
 
 ' Just so you can see when the Excel icon
 ' disappears from the Taskbar:
 ExcelApp.Visible = True

 Debug.Print "Open Workbook"
 Set ExcelWorkBook = ExcelApp.Workbooks.Open(sExcelFile)
 
 Debug.Print "Close Workbook"
 ExcelWorkBook.Close
 Set ExcelWorkBook = Nothing
 
 
 ' > "this line terminates the process"
 ' Actually, no - it doesn't.
 '
 ' The following code line causes Excel to disappear
 ' from the Taskbar, but Excel remains in the list
 ' of processes in Windows Task Manager:
 ExcelApp.Quit
 
 
 ' The following code line causes the
 ' Excel process to disappear from Task Manager.
 Set ExcelApp = Nothing
 
 ' NOTE:
 '
 ' If the above code line is omitted, the Excel
 ' process won't disappear from the Windows Task
 ' Manager until the ExcelApp variable goes out of
 ' scope (when this function terminates if the
 ' variable is declared within this function).
 '
 ' HOWEVER, if the above code line is omitted
 ' and the ExcelApp variable is declared in the
 ' General Declarations Section (at the top of
 ' the module), then the Excel process won't
 ' disappear from the Windows Task Manager.
 ' Perhaps that's what you're doing.


 ' Initialize this function's return value:
 iResult = 1

Exit_TestOpenCloseExcel:

 ' Set this function's return value:
 TestOpenCloseExcel = iResult
 Exit Function
 
Error_TestOpenCloseExcel:

 Debug.Print "(" & Err.Number & ") " & Err.Description
 Resume Exit_TestOpenCloseExcel
 
End Function
    • Marked as answer by
      Bessie Zhao
      Tuesday, February 8, 2011 9:14 AM

Источник

Sorry in advance for the long post but I wanted to provide as much detail as possible.

Running Excel 2016 32-bit. We have a large macro enabled excel file (65+ MB) with ~8 queries to other reports run and placed in a server location, along with many calculations to generate a dashboard report of active projects. We have two VBScripts that run through task scheduler. The first opens and runs macros to refresh all queries, then refresh each pivot table, and finally resize some reporting tables to match the new size of the pivot table. The second copies four sheets to a new excel file, pastes as data, generates a PDF of two of those sheets, then attaches both the new excel and the PDF to an email sent via VB script. I’ll post as much of the codes as possible below.

All files are located on a server (‘ME Based Server’ in the codes below) and run locally on that server. The refresh script takes up to 15 minutes to run and the reporting script then takes ~ 4 minutes. This works without issue ~90% of the time.

The other 10% of the time, a few things may happen:

  • It may run successfully, but leave an instance of Excel open (probably in a non-responsive state) which is tying up more than 50% of the processing cores and ~490,000 KB of RAM.

  • It may run the refresh successfully, but fail on the report script which means we don’t receive the automated email and it leaves an instance of Excel open.

  • It may fail during the refresh and leave an instance of Excel open.

This is scheduled 4 times a day and if one fails then each new run will open a new instance of Excel which will also fail but tie up more of the servers resources.

We’re looking for advice to ensure that the instance of Excel closes even after failures to not bear down or overwork the server. Any advise will be greatly appreciated.

Refresh Code: Set objFSO = CreateObject(«Scripting.FileSystemObject») Set oShell = WScript.CreateObject(«WScript.Shell») On Error Resume Next Const DeleteReadOnly = True

strSourceFolder1 = "\'US Based Server'EngineeringDashboardReport"
strDestFolder1 = "\'ME Based Server'EngineeringDashboardReport"
Set colFiles1 = objFSO.GetFolder(strSourceFolder1)

For Each objFile1 In colFiles1.Files
	If objNewestFile1 = "" Then   
		Set objNewestFile1 = objFile1  
	  Else   
		  If objNewestFile1.DateLastModified < objFile1.DateLastModified Then    
			Set objNewestFile1 = objFile1   
		  End If  
	End If
Next

If Not objNewestFile1 Is Nothing Then 
	objFSO.DeleteFile(strDestFolder1 & "*.xlsx"), DeleteReadOnly
	oShell.Run "xcopy.exe " & chr(34) & objNewestFile1 & chr(34) & " " & chr(34) & strDestFolder1 & chr(34) & " /R /Y"
End If

strSourceFolder2 = "\'US Based Server'EPT_BAH Revision Summary"
strDestFolder2 = "\'ME Based Server'EPT_BAH Revision Summary"
Set colFiles2 = objFSO.GetFolder(strSourceFolder2)

For Each objFile2 In colFiles2.Files
	If objNewestFile2 = "" Then   
		Set objNewestFile2 = objFile2  
	  Else   
		  If objNewestFile2.DateLastModified < objFile2.DateLastModified Then    
			Set objNewestFile2 = objFile2   
		  End If  
	End If
Next

If Not objNewestFile2 Is Nothing Then 
	objFSO.DeleteFile(strDestFolder2 & "*.xlsx"), DeleteReadOnly
	oShell.Run "xcopy.exe " & chr(34) & objNewestFile2 & chr(34) & " " & chr(34) & strDestFolder2 & chr(34) & " /R /Y"
End If

strSourceFolder3 = "\'US Based Server'EPT_Weekly Forecast"
strDestFolder3 = "\'ME Based Server'EPT_Weekly Forecast"
Set colFiles3 = objFSO.GetFolder(strSourceFolder3)

For Each objFile3 In colFiles3.Files
	If objNewestFile3 = "" Then   
		Set objNewestFile3 = objFile3  
	  Else   
		  If objNewestFile3.DateLastModified < objFile3.DateLastModified Then    
			Set objNewestFile3 = objFile3  
		  End If  
	End If
Next

If Not objNewestFile3 Is Nothing Then 
	objFSO.DeleteFile(strDestFolder3 & "*.xlsx"), DeleteReadOnly
	oShell.Run "xcopy.exe " & chr(34) & objNewestFile3 & chr(34) & " " & chr(34) & strDestFolder3 & chr(34) & " /R /Y"
End If

strSourceFolder4 = "\'US Based Server'ISO_Spool Summary"
strDestFolder4 = "\'ME Based Server'ISO_Spool Summary"
Set colFiles4 = objFSO.GetFolder(strSourceFolder4)

For Each objFile4 In colFiles4.Files
	If objNewestFile4 = "" Then   
		Set objNewestFile4 = objFile4  
	  Else   
		  If objNewestFile4.DateLastModified < objFile4.DateLastModified Then    
			Set objNewestFile4 = objFile4   
		  End If  
	End If
Next

If Not objNewestFile4 Is Nothing Then 
	objFSO.DeleteFile(strDestFolder4 & "*.xlsx"), DeleteReadOnly
	oShell.Run "xcopy.exe " & chr(34) & objNewestFile4 & chr(34) & " " & chr(34) & strDestFolder4 & chr(34) & " /R /Y"
End If

Set objNewestFile1 = Nothing
Set objNewestFile2 = Nothing
Set objNewestFile3 = Nothing
Set objNewestFile4 = Nothing

MasterDB = "\'ME Based Server'BacklogTracker-BE.accdb"
StaticDB = "\'ME Based Server'Query Lookup DataBacklogTracker-BE.accdb"

objFSO.DeleteFile StaticDB
objFSO.CopyFile MasterDB, StaticDB

Set objExcel = CreateObject("Excel.Application") 

objExcel.Visible = True
objExcel.ScreenUpdating = True
objExcel.DisplayAlerts = False
objExcel.AskToUpdateLinks = False
objExcel.AlertBeforeOverwriting = False

extension = "xlsm"
sourceDirectory = "\'ME Based Server'ENG PROD TRACKER"
BahBLTracker = "\'ME Based Server'Backlog Tracker Query.xlsm"
Set objWorkbook = objExcel.Workbooks.Open(BahBLTracker)
objExcel.Calculation = xlManual
objExcel.Run "'Backlog Tracker Query.xlsm'!RefreshAll.RefreshAll"
objWorkbook.Save
Set objWorkbook = Nothing

Set objFolder = objFSO.GetFolder(sourceDirectory)
For Each objFile In objFolder.Files
	If LCase((objFSO.GetExtensionName(objFile))) = LCase(extension) Then
		Filename = objFile.Name
		Filename = sourceDirectory & "" & Filename
		Set objWorkbook = objExcel.Workbooks.Open(Filename)
		objExcel.Calculation = xlManual
		RefreshAll = "'" & objFile.Name & "'!RefreshAll.RefreshAll"
		ResizeTables = "'" & objFile.Name & "'!ResizeTables.ResizeTables"
		objExcel.Run RefreshAll
		objExcel.Run ResizeTables
		objExcel.Calculation = xlAutomatic
		objWorkbook.Save
	End If
Next

objExcel.Calculation = xlAutomatic
objExcel.Quit
Set objWorkbook = Nothing
Set objFile = Nothing
Set objFolder = Nothing
Set objExcel = Nothing
Set oShell = Nothing
Set objFSO = Nothing

Reporting Code:

'~~~Copy from Query file to final Excel & PDF report~~~
	Dim objExcel, objWbTemp, objWbFin
	Dim tempFileName, sourceDirectory, extension, Filename, ReportFilename, PDFReportName
	Dim objFSO, objFolder, objFile
	On Error Resume Next
	Const DeleteReadOnly = True

	tempFileName = "\'ME Based Server'EngineeringReportingTemptemp.xlsm"
	ReportFilename = "\'ME Based Server'EngineeringProductionTrackerENG PROD TRACKERReports to EmailEngineering Production Tracker " & Right("0" & DatePart("d", Now), 2) & " " & MonthName(Month(Now()),1) & " " & DatePart("YYYY", Now) & " Hour " & Right("0" & Hour(FormatDateTime(Now(),4)), 2) & " AST.xlsx"
	
	Set objExcel = CreateObject("Excel.Application")
	' objExcel.ScreenUpdating = False 'When active, causes error on line "NOTED" below
	objExcel.Visible = True
	objExcel.DisplayAlerts = False
	
	extension = "xlsm"
	sourceDirectory = "\'ME Based Server'EngineeringProductionTrackerENG PROD TRACKER"
	
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objFolder = objFSO.GetFolder(sourceDirectory)
	objFSO.DeleteFile("\'ME Based Server'EngineeringProductionTrackerENG PROD TRACKERReports to Email*.xlsx"), DeleteReadOnly
	objFSO.DeleteFile("\'ME Based Server'EngineeringProductionTrackerENG PROD TRACKERReports to Email*.pdf"), DeleteReadOnly
	
	For Each objFile In objFolder.Files
		If LCase((objFSO.GetExtensionName(objFile))) = LCase(extension) Then
			Filename = objFile.Name
			Filename = sourceDirectory & Filename
			objFSO.CopyFile Filename, tempFileName
			Set objWbTemp = objExcel.Workbooks.Open(tempFileName)
			objWbTemp.Sheets("Engineering Tracker-SP").Select
			objExcel.Cells.Select
			objExcel.Selection.Copy
			objExcel.Selection.PasteSpecial -4163 '-4163 is VBS code for paste values
			objExcel.Range("C5").Select
			objWbTemp.Sheets("Engineering Tracker-LP").Select
			objExcel.Cells.Select
			objExcel.Selection.Copy
			objExcel.Selection.PasteSpecial -4163 '-4163 is VBS code for paste values
			objExcel.Range("C5").Select
			objWbTemp.Sheets("USENG@700NotOnHoldDetails").Select
			objExcel.Cells.Select
			objExcel.Selection.Copy
			objExcel.Selection.PasteSpecial -4163 '-4163 is VBS code for paste values
			objExcel.Range("A2").Select
			objWbTemp.Sheets("USENGOnHoldDetails").Select
			objExcel.Cells.Select
			objExcel.Selection.Copy
			objExcel.Selection.PasteSpecial -4163 '-4163 is VBS code for paste values
			objExcel.Range("A2").Select
			' Make final report Excel File
			Set objWbFin = objExcel.Workbooks.Add()
			objWbFin.SaveAs(ReportFilename)
			objWbTemp.Sheets("Engineering Tracker-LP").Copy objWbFin.Sheets(objWbFin.Sheets.Count)
			objWbTemp.Sheets("Engineering Tracker-SP").Copy objWbFin.Sheets(objWbFin.Sheets.Count)
			objWbTemp.Sheets("USENG@700NotOnHoldDetails").Copy objWbFin.Sheets(objWbFin.Sheets.Count)
			objWbTemp.Sheets("USENGOnHoldDetails").Copy objWbFin.Sheets(objWbFin.Sheets.Count)
			objWbFin.Sheets("Sheet1").Delete
			' Convert Summaries to PDF
			objWbFin.Sheets(Array("Engineering Tracker-LP", "Engineering Tracker-SP")).Select
			PDFReportName = Left(ReportFilename , InstrRev(ReportFilename , ".") - 1) & ".pdf"
			objWbFin.ActiveSheet.ExportAsFixedFormat 0, PDFReportName, 0, 1, 0,,,0
			objWbFin.Sheets("Engineering Tracker-LP").Select ' "NOTED" line that errors when ScreenUpdating = False
			objExcel.Range("C5").Select
			' Close and Cleanup
			objWbFin.Close True
			objWbTemp.Close False
			objFSO.DeleteFile tempFileName
		End If
	Next
	
	'~~> Close and Cleanup
	objExcel.Quit
	Set objWbFin = Nothing
	Set objWbTemp = Nothing
	Set objExcel = Nothing
	Set objFSO = Nothing
	Set objFolder = Nothing
	Set objWMIService = Nothing
	Set colItems = Nothing

'~~~Send Report file in email~~~
	' Create link to CDOmail
	Set objEmail = CreateObject("CDO.Message")

	' Enter subject of message in quotes
	objEmail.Subject = "Engineering Production Tracker " & Right("0" & DatePart("d", Now), 2) & " " & MonthName(Month(Now()),1) & " " & DatePart("YYYY", Now) 

	' Enter email address of sender within quotes ie
	objEmail.From = "sender"

	' Enter destination email address in quotes.
	objEmail.To = "name"
	objEmail.Cc = "names"

	' This is the email body.
	objEmail.HTMLBody = "This email contains the latest update to the Engineering Production Tracker Report.<hr />This is an automated email.<br />Replies to this address will not be received."

	objEmail.AddAttachment ReportFilename 'NOTE: DO NOT USE AN "=" SIGN AFTER "AddAttachment"
	objEmail.AddAttachment PDFReportName 'NOTE: DO NOT USE AN "=" SIGN AFTER "AddAttachment"

	' Also note replace mail.mcdermott.com and Port 25 with whatever your SMTP Server is using. Port is TYPICALLY 25 but some providers use a custom port

	objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = #
	objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "domain" 
	objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = #
	objEmail.Configuration.Fields.Update

	objEmail.Send
	'Wscript.Echo "DONE"
	'Wscript.Quit

RefreshAll VBA Macro:

Sub RefreshAll()
    On Error Resume Next
    ActiveWorkbook.RefreshAll
End Sub

ResizeTables VBA Macro:

Sub ResizeTables()
    On Error Resume Next
    Dim RowCount As Long, LastRow As Long
' Resize USONHOLD Table
    RowCount = ThisWorkbook.Sheets("US ENG On Hold Details").Range("A4", ThisWorkbook.Sheets("US ENG On Hold Details").Range("A4").End(xlDown)).Rows.Count
    LastRow = ThisWorkbook.Sheets("USENGOnHoldDetails").Range("A1", ThisWorkbook.Sheets("USENGOnHoldDetails").Range("A" & RowCount + 1).End(xlDown)).Rows.Count
    ThisWorkbook.Sheets("USENGOnHoldDetails").Rows(3 & ":" & LastRow).Delete
    ThisWorkbook.Sheets("USENGOnHoldDetails").ListObjects("USOnHold").Resize ThisWorkbook.Sheets("USENGOnHoldDetails").ListObjects("USOnHold").Range.Resize(RowCount - 1)
' Resize US700NOH Table
    RowCount = ThisWorkbook.Sheets("US ENG @700 Not On Hold Details").Range("B4", ThisWorkbook.Sheets("US ENG @700 Not On Hold Details").Range("B4").End(xlDown)).Rows.Count
    LastRow = ThisWorkbook.Sheets("USENG@700NotOnHoldDetails").Range("A1", ThisWorkbook.Sheets("USENG@700NotOnHoldDetails").Range("A" & RowCount + 1).End(xlDown)).Rows.Count
    ThisWorkbook.Sheets("USENG@700NotOnHoldDetails").Rows(3 & ":" & LastRow).Delete
    ThisWorkbook.Sheets("USENG@700NotOnHoldDetails").ListObjects("US700NOH").Resize ThisWorkbook.Sheets("USENG@700NotOnHoldDetails").ListObjects("US700NOH").Range.Resize(RowCount - 1)
    ThisWorkbook.Sheets("Engineering Tracker-LP").Activate
End Sub
Источник

Fluff

Fluff

MrExcel MVP, Moderator


  • #2

Move the Close line above where you set the variables to Nothing.

  • #3

Move the Close line above where you set the variables to Nothing.

Still the same unfortunatly :(

Fluff

Fluff

MrExcel MVP, Moderator


  • #4

How about

VBA Code:

With xls
    .Visible = False

  ActiveWorkbook.Sheets("log").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 3) = Array(Me.txtProduct.Value, Me.txtQuantity.Value, Me.txtCountUp.Value)
   wkb.Close True
   xls.Quit
    Set wks = Nothing
    Set wkb = Nothing
    Set xls = Nothing
  
    
End With

  • #5

Nope, Compile Error Expected Function Or Variable on the wkb.close D:

This is so frustrating for something that should be so easy!!

Fluff

Fluff

MrExcel MVP, Moderator


  • #6

Not sure why you are getting that, as it works for me.
I very rarely use Access, so don’t know much about it.

RoryA

RoryA

MrExcel MVP, Moderator


  • #7

You’re not properly qualifying the Excel objects, which is why you end up with orphaned processes running. Try this:

VBA Code:

Private Sub Export_Click()
 
    Dim xls     As Excel.Application
    Dim wkb     As Excel.Workbook
    Dim wks     As Excel.Worksheet
    
    Set xls = CreateObject("Excel.Application")
    Set wkb = xls.Workbooks.Open("c:usersxdesktoploggerlog.csv")
    Set wks = wkb.Worksheets("log")

    xls.Visible = False
    
    wks.Range("A" & wks.Rows.Count).End(xlUp).Offset(1).Resize(, 3) = Array(Me.txtProduct.Value, Me.txtQuantity.Value, Me.txtCountUp.Value)
    wbk.Close True

    Set wks = Nothing
    Set wkb = Nothing
    Set xls = Nothing

End Sub

  • #8

You’re not properly qualifying the Excel objects, which is why you end up with orphaned processes running. Try this:

VBA Code:

Private Sub Export_Click()

    Dim xls     As Excel.Application
    Dim wkb     As Excel.Workbook
    Dim wks     As Excel.Worksheet
   
    Set xls = CreateObject("Excel.Application")
    Set wkb = xls.Workbooks.Open("c:usersxdesktoploggerlog.csv")
    Set wks = wkb.Worksheets("log")

    xls.Visible = False
   
    wks.Range("A" & wks.Rows.Count).End(xlUp).Offset(1).Resize(, 3) = Array(Me.txtProduct.Value, Me.txtQuantity.Value, Me.txtCountUp.Value)
    wbk.Close True

    Set wks = Nothing
    Set wkb = Nothing
    Set xls = Nothing

End Sub

Thanks for this, interestingly enough this now works, and runs each time, however it is still creating a Microsoft Excel process in the background, each time I click it it creates a new one, but it now does not error, so that’s progress haha.

Clicking the button 5 times = 5 seperate Excel processes running

RoryA

RoryA

MrExcel MVP, Moderator


  • #9

Oops — you’re missing a line that looks like:

  • #10

Oops — you’re missing a line that looks like:

I was just about to say, managed to figure that out myself, works perfectly, thank you very much my dude!

Источник

  • #1

Okay, this one is driving me bananas.

I have a driver procedure that is supposed to call a number of sub-procedures, then close the spreadsheet I was importing from and quit Excel.

Here is the code. Please excuse the mess, it’s still under development, so this isn’t my final code by any means.

Code: 

Private Sub cmdImportCase_Click()
 
Dim CaseData As Collection
Dim ValCheck As clsFieldData
 
On Error GoTo ErrHandler

    If Not CaseData Is Nothing Then Set CaseData = Nothing
    Set CaseData = New Collection
    HeaderRow = GetDBOption("ArchiveImport_HeaderRow", otNumber, dbeBackEnd)
    
    CurrentDb.Execute "DELETE * FROM tblArchiveCaseStaging", dbSeeChanges + dbFailOnError
    CurrentDb.Execute "DELETE * FROM tblArchiveClaimStaging", dbSeeChanges + dbFailOnError
 
    [COLOR=seagreen]'Open the source file and assign values to xlApp, xlWorkBook, and xlWorkSheet.[/COLOR]
    If OpenImportFile() Then
        [COLOR=seagreen]'Verify the format of the source file.[/COLOR]
        If (VerifyCaseRows() And VerifyColumnNames()) Then
            [COLOR=seagreen]'The data file has been found and opened.  Import and stage the CASE information.[/COLOR]
            If ImportHeader(CaseData) Then
                If ImportClaimData() Then
                    MsgBox "Import Complete."
                End If
            End If
        Else
            Beep
            ShowMsg "The source file is formatted incorrectly." & vbCrLf & vbCrLf & _
                    "If you feel you have received this message in error, please contact PIU App Support.", _
                    "INVALID FILE FORMAT", _
                    "VALIDATION FAILURE", _
                    mbCritical
        End If
    End If
    
    Me.RecordSource = "tblArchiveCaseStaging"
    
    Call ToggleVisibility(True)
    If Me.txtFileNumber.Visible Then Me.txtFileNumber.SetFocus
    
ProcExit:
    On Error Resume Next
    If Not xlWorkSheet Is Nothing Then Set xlWorkSheet = Nothing
    If Not xlWorkBook Is Nothing Then
        xlWorkBook.Close SaveChanges:=False
        Set xlWorkBook = Nothing
    End If
    If Not xlApp Is Nothing Then
        xlApp.Quit
        Set xlApp = Nothing
    End If
    Exit Sub
    
ErrHandler:
    Trap.Handle Me.Name, "cmdImportCase_Click"
    Resume ProcExit
    
End Sub

The Excel variable declarations are module-level:

Code: 

[COLOR=seagreen]'Early bound - FOR DEVELOPMENT ONLY[/COLOR]
Dim xlApp As Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheet As Excel.Worksheet
 
[COLOR=seagreen]'Late bound - FOR RELEASE VERSIONS
'Dim xlApp As Object
'Dim xlWorkBook As Object
'Dim xlWorkSheet As Object[/COLOR]

The objects themselves are assigned in OpenImportFile. There is some extra stuff, but the actual assignments are pretty standard:

Code: 

       [COLOR=seagreen]'Open a new session of Excel and then open the workbook.[/COLOR]
        Set xlApp = CreateObject("Excel.Application")
                
       [COLOR=seagreen]'Open the indicated workbook and worksheet[/COLOR]
        Set xlWorkBook = xlApp.Workbooks.Open(FileName:=SourceFilePath)
        Set xlWorkSheet = xlWorkBook.Sheets("INPUT FILE")

(I’m deliberately opening a new instance of Excel instead of using any existing one specifically so I can hide the workbook and close it when I’m done, since this is a straight validation and data import.)

So here is the situation:

While the cleanup in ProcExit works perfectly if the user has no other instances of Excel open, if they already have any open, then this code opens the spreadsheet being imported in a new, visible instance of Excel, then leaves it open rather than closing it out. Stepping through the cleanup code in ProcExit shows that every line is being executed; they just aren’t DOING anything.

Any thoughts on why this is acting like this or how to fix that would be most appreciated.

  • #2

Also, I’ve checked with it Resume Next turned off, and no errors are being suppressed by it.

JHB

Have been here a while


  • #3

I would also comment that out:

What happen if you only have xlApp.Quit in ProcExit:.

  • #4

It’s not throwing any errors at all, even after removing all error handling. I’ve stepped through the entire procedure, and everything works, except for closing out. It just outright ignores the Workbook.Close and Excel.Quit commands. Doesn’t even throw any errors on them — it just process them and does nothing.

It appears to be something about saving changes — I’ve changed the workbook assignment to include ReadOnly:=True and the issue went away.

I don’t know what precisely was causing it or how to fix it if I ever need to change a workbook and then import something (I tested with Workbook.Close SaveChanges:=True and the behavior never changed), but for now, I’ll take what I can get. I would love to know WHY it was showing the workbook and refusing to close out, though, even if I DID find a work-around.

Oh, nearly forgot:

What happen if you only have xlApp.Quit in ProcExit:.

Absolutely no changes. The workbook appears, Excel stays open, and no errors are thrown.

Last edited: Jun 6, 2018

  • #5

Interestingly, unless I use that ReadOnly:=True, about 5 seconds after the procedure terminates, a pop-up appears in Excel saying ‘ArchiveTest.xlsx is now available for editing. Chose Read-Write to open it for editing.’ with a Read-Write and a Cancel button.

Источник

Понравилась статья? Поделить с друзьями:
  • Excel not calculating sum
  • Excel norm inv на русском
  • Excel no ipad mini
  • Excel no formula results
  • Excel new activexobject excel application