Determine if application is running with Excel

Question

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...

Answer 1

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

Answer 2

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.

Answer 3

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

Answer 4

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.