Avatar of stephenlecomptejr
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
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
VB ScriptMicrosoft AccessVBAMicrosoft Excel

Avatar of undefined
Last Comment
stephenlecomptejr

8/22/2022 - Mon