Code for Killing the Excel Object
Fortunately the Excel Application Object offers a Caption so it is possible to fetch the corresponding Window/PID to kill Excel.
Do this with the following code in three steps
Create Excel Object
Get PID by naming the Caption
KillProcess by PID
To test the code, place the first part into a module and the second part on a form with Command1 button.
*******************************
Module part
*******************************
***************************************************************************************
Constants to set buffer sizes, rights, and determine OS Version
***************************************************************************************
Public Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Public Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Public Const LANG_NEUTRAL = &H0
Public Const SUBLANG_DEFAULT = &H1
Public Const GW_HWNDFIRST = 0
Public Const GW_HWNDLAST = 1
Public Const GW_HWNDNEXT = 2
Public Const GW_HWNDPREV = 3
Public Const GW_OWNER = 4
Public Const GW_CHILD = 5
Public Function KillProcessById(p_lngProcessId As Long, ErrorMSG As String) As Boolean
Dim lnghProcess As Long
Dim lngReturn As Long
get Process handle
lnghProcess = OpenProcess(1&, -1&, p_lngProcessId)
terminate the Process
lngReturn = TerminateProcess(lnghProcess, 0&)
get error message and return it for later use
ErrorMSG = RetrieveError
return success value
KillProcessById = (lngReturn = 0)
End Function
Private Function RetrieveError() As String
Dim strBuffer As String
Create a string buffer
strBuffer = Space(200)
Format the message string
FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, GetLastError, LANG_NEUTRAL, strBuffer, 200, ByVal 0&
Show the message
RetrieveError = strBuffer
End Function
Public Function KillApplicationByCaption(p_strApplicationCaption As String, p_strClassname As String, ErrorMSG As String) As Boolean
Dim PID&
get PID
PID = PIDofWindow(0, p_strApplicationCaption, p_strClassname)
Kill Process
KillApplicationByCaption = KillProcessById(PID, ErrorMSG)
End Function
Public Function PIDofWindow(ByVal hWndStart As Long, WindowText As String, Classname As String) As Long
Dim hwnd As Long
Dim PID As Long
Dim sWindowText As String
Dim sClassname As String
Dim r As Long
Hold the level of recursion
Static level As Integer
Initialize if necessary.
If level = 0 Then
If hWndStart = 0 Then hWndStart = GetDesktopWindow()
End If
Increase recursion counter
level = level + 1
Get first child window
hwnd = GetWindow(hWndStart, GW_CHILD)
Do Until hwnd = 0
Search children by recursion
Call PIDofWindow(hwnd, WindowText, Classname)
Get the window text and class name
sWindowText = Space$(255)
r = GetWindowText(hwnd, sWindowText, 255)
sWindowText = Left(sWindowText, r)
sClassname = Space$(255)
r = GetClassName(hwnd, sClassname, 255)
sClassname = Left(sClassname, r)
Check if window found matches the search parameters
If (sWindowText Like WindowText) And _
(sClassname Like Classname) Then
Get PID of found Window
Call GetWindowThreadProcessId(hwnd, PID)
PIDofWindow = PID
only return the first matching window.
Exit Do
End If
Get next child window
hwnd = GetWindow(hwnd, GW_HWNDNEXT)
Loop
Reduce the recursion counter
level = level - 1
End Function
*******************************
Form part
*******************************
Option Explicit
declare Excel Variables
Dim xlApp As Excel.Application
Dim xlAppPID As Long
Dim xlWorkbooks As Excel.Workbooks
Dim xlWorkbook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Private Sub Command1_Click()
Dim ErrorMSG$
Create an Excel Instance
Set xlApp = CreateObject("Excel.Application")
If (Not xlApp Is Nothing) Then
Get PID of just created xlApp and store it for further use
create workbooks
Set xlWorkbooks = xlApp.Workbooks
Set xlWorkbook = xlWorkbooks.Add
Set xlSheet = xlWorkbook.Worksheets.Add
xlAppPID = PIDofWindow(0, xlApp.Caption, "XLMAIN")
Else
MsgBox "ERROR: Unable initialize Excel Application Connector. Check local Excel installation.", vbOKOnly + vbExclamation, "Error"
End If
do some work
....
xlSheet.Cells(1, 1) = "Test"
xlSheet.Cells(2, 1) = "this"
xlSheet.Cells(3, 1) = "Sheet"
Close Excel again
If (Not xlApp Is Nothing) Then
App.OleServerBusyTimeout = 1
App.OleServerBusyRaiseError = True
xlApp.DisplayAlerts = False
close and save your work
Call xlWorkbook.Close(True, App.Path + "\SavedWork.xls")
close any other open workbook
For Each xlWorkbook In xlWorkbooks
On Local Error Resume Next
Call xlWorkbook.Close(False)
On Local Error GoTo 0
Next xlWorkbook
Free Mem
Set xlSheet = Nothing
Set xlWorkbook = Nothing
Set xlWorkbooks = Nothing
Quit Excel
xlApp.Quit
Set xlApp = Nothing
Call KillProcessById(xlAppPID, ErrorMSG)
Else
MsgBox "ERROR: Initialize Excel Application Connector first. User EXCEL.INIT", , True
End If
End Sub
