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