Ищете самый быстрый способ проверить, выполняется ли исполняемый файл с помощью Excel VBA

Question

У меня есть коды, которые проверяют, запущен ли исполняемый файл или нет, но проблема в том, что я нахожу его довольно медленным при проверке, исполняется ли исполняемый файл или нет. Есть ли самый быстрый способ сделать это?

 Public Function IsExeRunning(sExeName As String, Optional sComputer As 
 String = ".") As Boolean
     On Error GoTo Error_Handler
     Dim objProcesses    As Object

Set objProcesses = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2").ExecQuery("SELECT * FROM Win32_Process WHERE Name  like '" & sExeName & "'") ' = '" & sExeName & "'")
If objProcesses.Count <> 0 Then IsExeRunning = True

Error_Handler_Exit:
     On Error Resume Next
     Set objProcesses = Nothing
     Exit Function

Error_Handler:
    MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
        "Error Number: IsExeRunning" & vbCrLf & _
        "Error Description: " & Err.Description, _
        vbCritical, "An Error has Occured!"
     Resume Error_Handler_Exit
 End Function

Answer 1

Это может работать не совсем так, как вы ожидаете, поскольку подобный запрос не совсем правильно реализован. Я исправил это и добавил несколько оптимизаций, в основном уменьшив количество возвращаемых условий запроса, добавив метод точного соответствия и добавив метод кэширования для сохранения ссылки на компьютер перед запросом.

Option Explicit

'Function averages 0.03 seconds on my machine
Public Function IsExeRunning(sExeName As String, _
                             Optional sComputer As String = ".", _
                             Optional ExactMatch As Boolean = False) As Boolean
On Error GoTo Error_Handler
    Static Computer As Object
    Dim Process     As Object
    Dim SearchQuery As String
    IsExeRunning = False

    'Cache Computer reference
    If Computer Is Nothing Or sComputer <> "." Then Set Computer = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")

    'Build query
    If ExactMatch Then
        SearchQuery = "SELECT Name FROM Win32_Process WHERE Name = '" & sExeName & "'"
    Else
        SearchQuery = "SELECT Name FROM Win32_Process WHERE Name like '%" & sExeName & "%'"
    End If

    Set Process = Computer.ExecQuery(SearchQuery)
    If Process Is Nothing Then Exit Function
    If Process.Count = 0 Then Exit Function
    IsExeRunning = True

Error_Handler_Exit:
     Exit Function

Error_Handler:
     Resume Error_Handler_Exit
End Function

Sub TestRunner()
    Dim t As Single
    t = Timer
    Debug.Print "Function returns " & IsExeRunning("Excel", ".", False) & " took: " & Timer - t & " seconds"
End Sub