Excel.exe still running after using Application.Quit - excel

I'm trying to simplify a report template by writing VBA code that checks an Excel Workbook and fills in the Word document.
The code fails to terminate the Excel.exe process in Task Manager.
I tried solutions proposed here, other forums and in Microsoft's documentation. I gather it has to do with COM objects still existing when running the Application.Quit method but can't figure out where those come from.
When reducing the code down to it's most basic components there's no Excel.exe process still in Task Manager:
Private Sub Hämta_Click()
Dim XL As Excel.Application
Set XL = New Excel.Application
XL.Quit
Set XL = Nothing
End Sub
But as soon as I add to it, Excel.exe keeps running in Task Manager:
Private Sub Hämta_Click()
Dim XL As Excel.Application
Set XL = New Excel.Application
Dim wkb As Excel.Workbook
Set wkb = XL.Workbooks.Open("C:\Example.xls")
wkb.Close (False)
Set wkb = Nothing
XL.Quit
Set XL = Nothing
End Sub
I also tried this code with the same result:
Private Sub Hämta_Click()
Dim XL As Object
Set XL = CreateObject("Excel.Application")
Dim wkb As Object
Set wkb = XL.Workbooks.Open("K:\Uppdrag.xls")
wkb.Close (False)
Set wkb = Nothing
XL.Quit
Set XL = Nothing
End Sub
The above two macros keep creating instances of Excel.exe which are not closed.
I've seen examples where code snippets are included that kills the process via Task Manager, but I don't understand the reason for the above not working.
The only workaround I found is to not include the XL.Quit method and instead set XL.Visible = True and let the user manually close the window.

Based on the comments it does not seem to be possible to find the root cause why the newly created excel instance cannot be finished in a "normal" way.
Based on the code here one can just kill the process
Option Explicit
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Type LUID
LowPart As Long
HighPart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
TheLuid As LUID
Attributes As Long
End Type
Function ProcessTerminate(Optional lProcessID As Long, Optional lHwndWindow As Long) As Boolean
Dim lhwndProcess As Long
Dim lExitCode As Long
Dim lRetVal As Long
Dim lhThisProc As Long
Dim lhTokenHandle As Long
Dim tLuid As LUID
Dim tTokenPriv As TOKEN_PRIVILEGES, tTokenPrivNew As TOKEN_PRIVILEGES
Dim lBufferNeeded As Long
Const PROCESS_ALL_ACCESS = &H1F0FFF, PROCESS_TERMINATE = &H1
Const ANYSIZE_ARRAY = 1, TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8, SE_DEBUG_NAME As String = "SeDebugPrivilege"
Const SE_PRIVILEGE_ENABLED = &H2
On Error Resume Next
If lHwndWindow Then
'Get the process ID from the window handle
lRetVal = GetWindowThreadProcessId(lHwndWindow, lProcessID)
End If
If lProcessID Then
'Give Kill permissions to this process
lhThisProc = GetCurrentProcess
OpenProcessToken lhThisProc, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, lhTokenHandle
LookupPrivilegeValue "", SE_DEBUG_NAME, tLuid
'Set the number of privileges to be change
tTokenPriv.PrivilegeCount = 1
tTokenPriv.TheLuid = tLuid
tTokenPriv.Attributes = SE_PRIVILEGE_ENABLED
'Enable the kill privilege in the access token of this process
AdjustTokenPrivileges lhTokenHandle, False, tTokenPriv, Len(tTokenPrivNew), tTokenPrivNew, lBufferNeeded
'Open the process to kill
lhwndProcess = OpenProcess(PROCESS_TERMINATE, 0, lProcessID)
If lhwndProcess Then
'Obtained process handle, kill the process
ProcessTerminate = CBool(TerminateProcess(lhwndProcess, lExitCode))
Call CloseHandle(lhwndProcess)
End If
End If
On Error GoTo 0
End Function
And you just use the code like that
Sub TestIt()
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
' Do something with xlApp
'Terminate the process
ProcessTerminate , xlApp.hwnd
End Sub

Try to declare and use a workbooks variable then set it to nothing at the end of your code

Related

Change focus from Outlook to Excel

I have Outlook VBA code that gets specific text inside 'subject' mail, then opens and searches an Excel workbook for that text and if the text exists, shows a userform.
How do I set the focus from Outlook to Excel? The userform stays hidden and only shows when I click on the Excel window to activate it.
Sub abrirexecel()
Dim ExApp As Excel.Application, planilha As String
On Error Resume Next
planilha = "'C:\Users\Dyme\" & Format(Date, "yyyy-mm-dd") & "CodesSearch.xlsm'!funcaof12"
'funcaof12 is the macro name that opens userform
Set ExApp = GetObject(, "Excel.Application")
If Not ExApp Is Nothing Then
ExApp.Run planilha
End If
End Sub
Does anyone may give a help?
You can set an Excel userform to open on Top by adding in a calling function within the userform. If you call this from Outlook it will open the form on top without activating Excel currently (some work for the calling code is needed to properly close the excel session)
For Example:
In The Userform code
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Sub UserForm_Activate()
'check if we are using XL97 or not (hWndUF global variable)
hWndUF = IIf(Val(Application.Version) < 9, FindWindow("ThunderXFrame", Me.Caption), FindWindow("ThunderDFrame", Me.Caption))
End Sub
In the Excel Module
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const SWP_NOSIZE = &H1, SWP_NOMOVE = &H2, HWND_TOPMOST = -1, GW_HWNDNEXT = 2
Private Const FLAGS As Long = SWP_NOMOVE Or SWP_NOSIZE
Public hWndUF As Long
Public Function ShowUserForm()
Dim uf As Object: Set uf = UserForm1
uf.Show vbModeless
If hWndUF <> 0 Then SetWindowPos hWndUF, HWND_TOPMOST, 0, 0, 0, 0, FLAGS
End Function
Then in the Outlook module (this is dirty code and needs better object control; may look at later)
Sub ShowExcelUserForm()
' Requires reference: Microsoft Excel x.0 Data Objects library
Dim ExApp As Excel.Application: Set ExApp = New Excel.Application 'Set ExApp = GetObject(, "Excel.Application")
If Not ExApp Is Nothing Then
ExApp.Run "'C:\Users\snapier\Desktop\Stack Overflow 2019.xlsm'!ShowUserForm"
End If
End Sub

Detecting Lost Focus in Excel Application, Workbook or Worksheet

Switching to another application via the system ALT-Tab hotkey, while working in MS Excel on MS-Windows causes Excel to lose the keyboard focus. How to detect this?
The Deactivate or WindowDeactivate events for the objects: Application or Workbook or Worksheet objects do not fire when MS Excel loses focus this way (of course, because losing the focus is not synonymous with Deactivating the window)
Try this code, please. I found it somewhere to the internet, three years ago and only adapted to serve my needs. For instance, it could not be stopped because of a wrong declaration of UnhookWinEvent API. Take care to not monitor the focus lost or got by using a MsgBox. In this way, pressing 'OK' the focus will be received again and you will be in an infinite loop. The focus status will be returned in the active sheet, range "A1" (received focus), respectively, "A2" (lost focus):
Copy the next code on top of a module (in the declarations area):
Option Explicit
Private Const EVENT_SYSTEM_FOREGROUND = &H3&
Private Const WINEVENT_OUTOFCONTEXT = 0
Private Declare PtrSafe Function SetWinEventHook Lib "user32.dll" (ByVal eventMin As Long, _
ByVal eventMax As Long, ByVal hmodWinEventProc As LongLong, ByVal pfnWinEventProc As LongLong, _
ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long
Private Declare PtrSafe Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare PtrSafe Function UnhookWinEvent Lib "user32.dll" (ByVal hWinEventHook As Long) As Long
Private handlColl As Collection
Copy the next code inside the module:
Public Sub StartMonitoring() 'it can be called from a Workbook/Worksheet event
StartFocusMonitoring
End Sub
Public Function StartFocusMonitoring() As Long
If handlColl Is Nothing Then Set handlColl = New Collection
StartFocusMonitoring = SetWinEventHook(EVENT_SYSTEM_FOREGROUND, EVENT_SYSTEM_FOREGROUND, 0&, _
AddressOf WinEventFunc, 0, 0, WINEVENT_OUTOFCONTEXT)
handlColl.aDD StartFocusMonitoring
End Function
Public Sub StopEventHook(lHook As Long)
Dim LRet As Long
If lHook = 0 Then Exit Sub`
LRet = UnhookWinEvent(lHook)
End Sub
Public Sub StopMonitoring() 'it must be called manualy or by an event when need to stop monitoring...
'it did not work until I changed the StopEventHook declaration, using ByVal instead of ByRef
Dim vHook As Variant, lHook As Long
For Each vHook In handlColl
lHook = vHook
StopEventHook lHook
Next vHook
End Sub
Public Function WinEventFunc(ByVal HookHandle As Long, ByVal LEvent As Long, _
ByVal hWnd As Long, ByVal idObject As Long, ByVal idChild As Long, _
ByVal idEventThread As Long, ByVal dwmsEventTime As Long) As Long
'In case of an error the application will crush. So, bypassing the error is good to be done...`
On Error Resume Next
Dim thePID As Long`
If LEvent = EVENT_SYSTEM_FOREGROUND Then
GetWindowThreadProcessId hWnd, thePID
If thePID = GetCurrentProcessId Then
'Do not use here a MsgBox, because after pressing OK Excel application
'will receive focus and you will stay in an infinite loop...
Application.OnTime Now, "Event_GotFocus"
Else
Application.OnTime Now, "Event_LostFocus"
End If
End If
On Error GoTo 0
End Function
Public Sub Event_GotFocus()
Range("a1").value = "Received Focus"
Range("a2").value = ""
End Sub
Public Sub Event_LostFocus()
Range("a2").value = "Lost focus"
Range("a1").value = ""
End Sub
You must start monitoring from StartMonitoring Sub which can be called directly or through an event (Workbook_Open, for instance).
The monitoring can be stopped calling StopMonitoring Sub...

Communication between Microsoft Office instances in VBA

I'm trying to create a VBA script on an instance A for copying basic stuff on an instance B of Word generated by a tier program with a temporary and unpredictable name , so I'm not able to use the GetObject(Path,) to get this instance with the Path because I don't have it.
My temporary solution is a PowerShell running this command from the Instance A to get the name of all Windows with "Word" in the Title... and store it in a VBA variable to detect if the name is from an other Instance than Instance A :
Get-Process |Where-Object {$_.mainWindowTitle -like "*Word*"} |format-table mainwindowtitle
It works but I can't believe there is no way to detect all running instances of an Application directly from VBA even with an unknown path.
I tried ugly stuff like this in VBA to cross over different Instances without success:
Sub GetAllInstance()
Dim WordApp As Word.Application, wordInstance As Object
Set WordApp = GetObject(, "Word.Application")
For Each wordInstance In WordApp
MsgBox (wordInstance)
Next wordInstance
End Sub
And the Immediate Command show me that the GetObject only have information about my Instance A, resulting only 1 documents even if 3 are opened on separates instance:
?WordApp.Documents.Count
1
EDIT 20/02:
With the good advices of Cindy, I changed my approch trying to work with process, I successfully detected differents PID of my running instances with the code below:
Sub IsProcessRunning()
Dim process As String
Dim objList As Object
Dim xprocess As Variant
Dim wdApp As Word.Application
process = "Word.exe"
Set objList = GetObject("winmgmts:") _
.ExecQuery("select ProcessID from win32_process where name='" & process & "'")
For Each xprocess In objList
Debug.Print xprocess.ProcessID
AppActivate (xprocess.ProcessID)
Set wdApp = GetObject(, "Word.Application")
Debug.Print wdApp.Workbooks(1).Name
Next xprocess
End Sub
Unfortunatly, activate an application do not clear the ROT, I'm now trying to find a way to clear it and refresh it to register the new activated application in the ROT and use the GetObject with the good instance.
Finally found a solution !
With the code below, because I know where my third-software generate the temporary file with the new instance, I search the name of the file using HWND and the GetWindowText from user32 lib. It permit to me to assign the GetObject using the full path and make interaction between my two documents from two separated instances. Thanks to Cindy and Mathieu for their help:
' API declaration
Const GW_HWNDNEXT = 2
Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Sub CommandButton1_Click()
Dim openDoc As Document, sourceDoc As Document, targetDoc As Object
Dim hWndThis As Long
Dim sTitle As String
Dim xTable As Table
''' INITIALIZATION '''
'Assign the source Document
Set sourceDoc = ActiveDocument
'Detect each instance by Window Name, then assign it to different object
hWndThis = FindWindow(vbNullString, vbNullString)
While hWndThis
sTitle = Space$(255)
sTitle = Left$(sTitle, GetWindowText(hWndThis, sTitle, Len(sTitle)))
If sTitle Like "*tmp*.DOC*" Then
FileToOpen = Left(sTitle, Len(sTitle) - 8)
Set targetDoc = GetObject("C:\Users\xxxxx\AppData\Local\Temp" & "\" & FileToOpen)
GoTo EndLoop:
End If
hWndThis = GetWindow(hWndThis, GW_HWNDNEXT)
Wend
EndLoop:
End Sub

Determine if application is running with Excel

Goal
Have an Excel file with a "Search" button that opens a custom program. This program is used for researches. If the program is already opened when the user clicks on the button, make it popup and focus on that given program.
Current Situation
Here's the code I'm trying to use to make it work:
Search Button
Private Sub btnSearch_Click()
Dim x As Variant
Dim Path As String
If Not IsAppRunning("Word.Application") Then
Path = "C:\Tmp\MyProgram.exe"
x = Shell(Path, vbNormalFocus)
End If
End Sub
IsAppRunning()
Function IsAppRunning(ByVal sAppName) As Boolean
Dim oApp As Object
On Error Resume Next
Set oApp = GetObject(, sAppName)
If Not oApp Is Nothing Then
Set oApp = Nothing
IsAppRunning = True
End If
End Function
This code will work only when I put "Word.Application" as the executable. If I try to put "MyProgram.Application" the function will never see the program is running. How can I find that "MyProgram.exe" is currently opened?
Further more, I'd need to put the focus on it...
You can check this more directly by getting a list of open processes.
This will search based on the process name, returning true/false as appropriate.
Sub exampleIsProcessRunning()
Debug.Print IsProcessRunning("MyProgram.EXE")
Debug.Print IsProcessRunning("NOT RUNNING.EXE")
End Sub
Function IsProcessRunning(process As String)
Dim objList As Object
Set objList = GetObject("winmgmts:") _
.ExecQuery("select * from win32_process where name='" & process & "'")
IsProcessRunning = objList.Count > 0
End Function
Here's how I brought the search window to front:
Private Const SW_RESTORE = 9
Private Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Sub btnSearch_Click()
Dim x As Variant
Dim Path As String
If IsProcessRunning("MyProgram.exe") = False Then
Path = "C:\Tmp\MyProgram.exe"
x = Shell(Path, vbNormalFocus)
Else
Dim THandle As Long
THandle = FindWindow(vbEmpty, "Window / Form Text")
Dim iret As Long
iret = BringWindowToTop(THandle)
Call ShowWindow(THandle, SW_RESTORE)
End If
End Sub
Now if the window was minimized and the user clicks the search button again, the window will simply pop up.
Just want to point out that the Window Text may change when documents are open in the application instance.
For example, I was trying to bring CorelDRAW to focus and everything would work fine so long as there wasn't a document open in Corel, if there was, I would need to pass the complete name to FindWindow() including the open document.
So, instead of just:
FindWindow("CorelDRAW 2020 (64-Bit)")
It would have to be:
FindWindow("CorelDRAW 2020 (64-Bit) - C:\CompletePath\FileName.cdr")
As that is what would be returned from GetWindowText()
Obviously this is an issue as you don't know what document a user will have open in the application, so for anyone else who may be coming here, years later, who may be experiencing the same issue, here's what I did.
Option Explicit
Private Module
Private Const EXE_NAME As String = "CorelDRW.exe"
Private Const WINDOW_TEXT As String = "CorelDRAW 2020" ' This is common with all opened documents
Private Const GW_HWNDNEXT = 2
Private Const SW_RESTORE = 9
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Sub FocusIfRunning(parAppName as String, parWindowText as String)
Dim oProcs As Object
Dim lWindowHandle As Long
Dim sWindowText As String
Dim sBuffer As String
' Create WMI object and execute a WQL query statement to find if your application
' is a running process. The query will return an SWbemObjectSet.
Set oProcs = GetObject("winmgmts:").ExecQuery("SELECT * FROM win32_process WHERE " & _
"name = '" & parAppName & "'")
' The Count property of the SWbemObjectSet will be > 0 if there were
' matches to your query.
If oProcs.Count > 0 Then
' Go through all the handles checking if the start of the GetWindowText()
' result matches your WindowText pre-file name.
' GetWindowText() needs a buffer, that's what the Space(255) is.
lWindowHandle = FindWindow(vbEmpty, vbEmpty)
Do While lWindowHandle
sBuffer = Space(255)
sWindowText = Left(sBuffer, GetWindowText(lWindowHandle, sBuffer, 255))
If Mid(sWindowText, 1, Len(parWindowText)) Like parWindowText Then Exit Do
' Get the next handle. Will return 0 when there are no more.
lWindowHandle = GetWindow(lWindowHandle, GW_HWNDNEXT)
Loop
Call ShowWindow(lWindowHandle , SW_RESTORE)
End If
End Sub
Private Sub btnFocusWindow_Click()
Call FocusIfRunning(EXE_NAME, WINDOW_TEXT)
End Sub
Hopefully somebody gets use from this and doesn't have to spend the time on it I did.
Just wanted to say thank you for this solution. Only just started playing around with code and wanted to automate my job a bit. This code will paste current selection in excel sheet into an already open application with as single click. Will make my life so much easier!!
Thanks for sharing
Public Const SW_RESTORE = 9
Public Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Sub updatepart()
'
' updatepart Macro
' copies current selection
' finds and focuses on all ready running Notepad application called Test
' pastes value into Notepad document
' Keyboard Shortcut: Ctrl+u
'
Dim data As Range
Set data = Application.Selection
If data.Count <> 1 Then
MsgBox "Selection is too large"
Exit Sub
End If
Selection.Copy
If IsProcessRunning("Notepad.EXE") = False Then
MsgBox "Notepad is down"
Else
Dim THandle As Long
THandle = FindWindow(vbEmpty, "Test - Notepad")
Dim iret As Long
iret = BringWindowToTop(THandle)
Call ShowWindow(THandle, SW_RESTORE)
End If
waittime (500)
'Call SendKeys("{F7}")
Call SendKeys("^v", True) '{F12}
Call SendKeys("{ENTER}")
End Sub
Function waittime(ByVal milliseconds As Double)
Application.Wait (Now() + milliseconds / 24 / 60 / 60 / 1000)
End Function
Function IsProcessRunning(process As String)
Dim objList As Object
Set objList = GetObject("winmgmts:") _
.ExecQuery("select * from win32_process where name='" & process & "'")
If objList.Count > 0 Then
IsProcessRunning = True
Else
IsProcessRunning = False
End If
End Function

Using timer to get Excel title

I have following code to get title of current opened excel file this code working fine. I use timer to every 10 seconds if title change then add new title in list1.
So question is there any method or event to detect if title change then my code work otherwise it not work not check. timer check every 10 seconds my pc work slow if I run this code
Private Const GW_HWNDNEXT = 2
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, _
ByVal wCmd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Sub ListWins(Optional Title = "*", Optional Class = "*")
Dim hWndThis As Long
hWndThis = FindWindow(vbNullString, vbNullString)
While hWndThis
Dim sTitle As String, sClass As String
sTitle = Space$(255)
sTitle = Left$(sTitle, GetWindowText(hWndThis, sTitle, Len(sTitle)))
sClass = Space$(255)
sClass = Left$(sClass, GetClassName(hWndThis, sClass, Len(sClass)))
If sTitle Like Title And sClass Like Class Then
Debug.Print sTitle, sClass
List1.AddItem (sTitle)
End If
hWndThis = GetWindow(hWndThis, GW_HWNDNEXT)
Wend
End Sub
Private Sub Timer1_Timer()
ListWins "*.xls*"
End Sub
The answer is No. AFAIK, No there is no event as such in vb6 which will trap the title change in Excel or any other window. Also unfortunately 10 second timer might not be good. What happens if the title changes every 2 seconds? It will not retrieve all the titles
However try this alternative which does not use the Timer Control. See if your pc is still slow...
Sub Sample()
'
' ~~> Rest of your code
'
Wait 2 '<~~ Wait for 2 seconds
'
' ~~> Rest of your code
'
End Sub
Private Sub Wait(ByVal nSec As Long)
nSec = nSec + Timer
While nSec > Timer
DoEvents
Wend
End Sub
You can use the Excel COM API to do this. Unfortunately, there is no way of getting the Excel window title - but you could easily manufacture it by appending " - Microsoft Excel". Use the FullName property if you want the complete path.
Option Explicit
Private WithEvents m_oApplication As Excel.Application
Private Sub Command_Click()
' Get a reference to the FIRST instance of the Excel application.
Set m_oApplication = GetObject(, "Excel.Application")
End Sub
Private Sub m_oApplication_NewWorkbook(ByVal Wb As Excel.Workbook)
List1.AddItem Wb.Name
End Sub
Private Sub m_oApplication_WorkbookAfterSave(ByVal Wb As Excel.Workbook, ByVal Success As Boolean)
'List1.AddItem "WorkbookAfterSave: " & Wb.FullName
List1.AddItem Wb.Name
End Sub
Private Sub m_oApplication_WorkbookOpen(ByVal Wb As Excel.Workbook)
List1.AddItem Wb.Name
End Sub

Resources