troubleshooting Question

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

Avatar of stephenlecomptejr
stephenlecomptejrFlag for United States of America asked on
VB ScriptMicrosoft AccessVBAMicrosoft Excel
4 Comments1 Solution755 ViewsLast Modified:
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
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
Set oShell = Nothing
Set colProcessList = Nothing
Set objWMIService = Nothing

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
  On Error Resume Next
  Set pFS1 = Nothing
  DeleteFile_feo = bValue
  Exit Function
  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 Sub
   '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)
    Set objFile = Nothing
  End If

  Exit Sub
  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

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

End Sub

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.Application.Visible = bShow

End Sub
Partha Mandayam
Technical Director

Our community of experts have been thoroughly vetted for their expertise and industry experience.

Join our community to see this answer!
Unlock 1 Answer and 4 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 4 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros