Weissenborn

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