Avatar of stephenlecomptejr
Flag 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
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

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

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

End Sub

Open in new window

VB ScriptMicrosoft AccessVBAMicrosoft Excel

Avatar of undefined
Last Comment

8/22/2022 - Mon