VBA Terminate set app = NEW office applications after task complete (Zombie applications VBA), PIDs vs app.hwnd handles
''When launching excel from VBA inside another applicaiton like outlook,
''it doesn't end/kill cleanly. Excel.exe remains resident for some reason.
''This KILLS the excel, however the xcel.hwnd handle is nothte same as the
''PID needed to kill it''So this cleans out the the zombie applicaiton created
''by a set xcel = NEW excel.application
#If VBA7 Then
Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As LongPtr, lpdwProcessId As Long) As Long
Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
#Else
Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If
Private Sub ExcelEnd(ByRef xlApp As Excel.Application)
xlApp.Quit
''xlapp.Wait (Now + TimeValue("0:00:02"))
Dim ProcID As Long
On Error Resume Next
ProcID = GetExcelProcessID(xlApp)
If ProcID <> 0 Then
Call Shell("taskkill /f /pid " & ProcID, vbHide)
End If
Set xlApp = Nothing
End Sub
Sub CheckAndCloseExcelInstances()
Dim xlApp As Object
Dim xlProcID As Long
' Attempt to get existing Excel instances
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
On Error GoTo 0
' Loop through all Excel instances
Do While Not xlApp Is Nothing
' Get the process ID of the Excel instance
xlProcID = GetExcelProcessID(xlApp)
' Check if there are any open workbooks
If xlApp.Workbooks.Count = 0 Then
' No open workbooks, close the Excel instance
xlApp.Quit
' Terminate Excel process using the obtained process ID
If xlProcID <> 0 Then
Call Shell("taskkill /f /pid " & xlProcID, vbHide)
End If
Else
' Iterate through each open workbook
Dim wb As Object
For Each wb In xlApp.Workbooks
' Optionally, perform actions on each open workbook
Debug.Print "Workbook Name: " & wb.name
Next wb
End If
' Release object reference
Set xlApp = Nothing
' Attempt to get the next Excel instance
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
On Error GoTo 0
Loop
' Clean up
Set xlApp = Nothing
End Sub
Function GetExcelProcessID(xlApp As Object) As Long
Dim xlHwnd As Long
Dim xlProcID As Long
' Get the window handle (hWnd) of the Excel application
xlHwnd = xlApp.hWnd
' Get the process ID (PID) of the Excel application using the window handle
If xlHwnd <> 0 Then
Call GetWindowThreadProcessId(xlHwnd, xlProcID)
End If
' Return the process ID
GetExcelProcessID = xlProcID
End Function
Comments
Post a Comment