stephenlecomptejr
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:
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
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:\excelfi letest.xls x")
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
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
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:\excelfi
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
error.png
What happens if you click on Ok button in the dialog?
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.
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Yep Partha, just like was said at the bottom of that link I needed to include:
Appreciate very much your comments!
Application.DisplayAlerts = False
then.... Application.Quit
Appreciate very much your comments!