Link to home
Start Free TrialLog in
Avatar of stephenlecomptejr
stephenlecomptejrFlag for United States of America

asked on

Overcome Cannot quit Microsoft Excel when ending all instances of Microsoft Excel using VBA and VBS Script.

Working on VBA / VBS script that will shut down Microsoft Excel no matter what without dialog 'Cannot quit Microsoft Excel' warning.  Please note (shown very below) attached image that describes error message and dialog box that comes up when you click on Help.

Here is the code I have in vbs:

Dim objWMIService
Dim colProcessList
Dim oShell
Dim objProcess
Dim i
for i = 1 to 2000
next
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colProcessList = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = 'excel.exe'")
Set oShell = CreateObject("WScript.Shell")
For Each objProcess in colProcessList
    oShell.Run "taskkill /im excel.exe",0 ,False
Next
Set oShell = Nothing
Set colProcessList = Nothing
Set objWMIService = Nothing
WScript.Quit

Open in new window


Here is the code I have in Excel VBA (should also work in MS Access VBA as well) that opens and runs the vbs script:
Main part of this when it can't delete an Excel file it runs this call:   Call ResetExcel

Public Function DeleteFile_feo(sFullFile As String) As Boolean
On Error GoTo Err_Proc

  Dim bValue As Boolean
  Dim pFS1 As Object
  Set pFS1 = CreateObject("Scripting.FileSystemObject")
  If pFS1.FileExists(sFullFile) = True Then
    pFS1.DeleteFile sFullFile
  End If
  bValue = True
  
Exit_Proc:
  On Error Resume Next
  Set pFS1 = Nothing
  DeleteFile_feo = bValue
  Exit Function
  
Err_Proc:
  If Err = 70 Then
    MsgBox ("Please remember that you cannot run this feature until you are out of Excel!  Please close out of any Excel sheets and re-run!  Thank you!")
    Call ResetExcel
    Resume Exit_Proc
  End If
  Call LogError_feo(Err, Err.Description, "modCommon @ DeleteFile_feo @ sFullFile: " & sFullFile)
  Resume Exit_Proc
  
End Function

Public Sub ResetExcel(Optional sErrorMsg As String = "")
On Error GoTo Err_This
  
  If MsgBox("Would you like the program to attempt to force-close out of all MS Excel documents to restart?  ** Warning ** does not save any Excel docs!", vbYesNo + vbQuestion) = vbYes Then
    Call CreateKillAllExcelFile
    Call RunKillAllExcelFiles
  End If
  
Exit_This:
  Exit Sub
  
Err_This:
   'Call LogError_feo(Err, Err.Description, "modCommon @ ResetExcel")
  
  Resume Exit_This
End Sub

Public Sub CreateKillAllExcelFile()
On Error GoTo Err_Proc

  Dim objFile As Object
  Dim wLine As Variant
  Dim sFileName As String
  
  sFileName = g_sLocalPath & m_sVBSFileName
  
  If FileExists_feo(sFileName) = False Then
  
    wLine = "Dim objWMIService"
    wLine = wLine & vbCrLf & "Dim colProcessList"
    wLine = wLine & vbCrLf & "Dim oShell"
    wLine = wLine & vbCrLf & "Dim objProcess"
    wLine = wLine & vbCrLf & "Dim i"
    
    wLine = wLine & vbCrLf & "for i = 1 to 2000"
    wLine = wLine & vbCrLf & "next"
    
    wLine = wLine & vbCrLf & "Set objWMIService = GetObject(" & Chr(34) & "winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2" & Chr(34) & ")"
    wLine = wLine & vbCrLf & "Set colProcessList = objWMIService.ExecQuery (" & Chr(34) & "Select * from Win32_Process Where Name = 'excel.exe'" & Chr(34) & ")"
    wLine = wLine & vbCrLf & "Set oShell = CreateObject(" & Chr(34) & "WScript.Shell" & Chr(34) & ")"
    wLine = wLine & vbCrLf & "For Each objProcess in colProcessList"
    wLine = wLine & vbCrLf & "    oShell.Run " & Chr(34) & "taskkill /im excel.exe" & Chr(34) & ",0 ,False"
    wLine = wLine & vbCrLf & "Next"
    wLine = wLine & vbCrLf & "Set oShell = Nothing"
    wLine = wLine & vbCrLf & "Set colProcessList = Nothing"
    wLine = wLine & vbCrLf & "Set objWMIService = Nothing"
    wLine = wLine & vbCrLf & "WScript.Quit"
    
    Dim fso As Object
    Set fso = CreateObject("scripting.filesystemobject")
    Set objFile = fso.CreateTextFile(sFileName, False)
    objFile.WriteLine (wLine)
    objFile.Close
    Set objFile = Nothing
  
  End If

Exit_Proc:
  Exit Sub
  
Err_Proc:
  Call LogError_feo(Err, Err.Description, "modCommon @ CreateKillExcelFile")
  Resume Exit_Proc
End Sub

Public Sub RunKillAllExcelFiles()
On Error GoTo Err_Proc

  Dim WSHShell As Object
  Dim WshEnv As Object
  Dim WinPath As String
  Dim strCmd As String
  Dim sFileName As String
  
  sFileName = g_sLocalPath & m_sVBSFileName
  strCmd = Chr(34) & "WScript" & Chr(34) & " " & Chr(34) & sFileName & Chr(34)
  Shell strCmd, vbNormalFocus
  Application.Quit

Exit_Proc:
  Exit Sub
  
Err_Proc:
  Call LogError_feo(Err, Err.Description, "modCommon @ RunKillAllExcelFiles")
  Resume Exit_Proc

End Sub

Open in new window


Please note error message that comes up via attached file:

To throw the error shown above in function:

put this in a code module:  and Call Sub StartError() open the Excel file before trying to delete it as DeleteFile_feo("c:\excelfiletest.xlsx")

Private m_xlApp As Object
Private m_xlBook As Object
Private m_xlSheet As Object

Public Sub StartError()

 sFullFileName = "c:\excelfiletest.xlsx"   'put name of your test file here.
 Set m_xlApp = CreateObject("Excel.Application")
    m_xlApp.DisplayAlerts = False
    'Opens Excel template always from the C:\ to reduce traffic
    Set m_xlBook = m_xlApp.Workbooks.Open(sFullFileName)

Set m_xlSheet = m_xlBook.Worksheets(sFullWorkSheetName)
  m_xlSheet.Activate
  m_xlSheet.Application.Visible = bShow
  

End Sub

Open in new window

error.png
Avatar of Partha Mandayam
Partha Mandayam
Flag of India image

What happens if you click on Ok button in the dialog?
Avatar of stephenlecomptejr

ASKER

In the image....if you click OK.  It just closes out the dialog box - but doesn't shut down Excel completely.
I'm willing to go as far as to set a registry setting to force it to close out completely and already have VBA and VBS script to handle that.
ASKER CERTIFIED SOLUTION
Avatar of Partha Mandayam
Partha Mandayam
Flag of India image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Yep Partha, just like was said at the bottom of that link I needed to include:

Application.DisplayAlerts = False

Open in new window

then....

Application.Quit

Open in new window


Appreciate very much your comments!