寻找最快的方法来检查可执行文件是否仍在使用excelvba运行



我有一个代码可以检查可执行文件是否仍在运行,但问题是我发现在检查可执行的文件是否正在运行时速度很慢。有最快的方法吗?

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 & "rootcimv2").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

这可能没有像您预期的那样工作,因为类似的查询没有完全正确实现。我已经修复了这个问题,并添加了一些优化,主要是减少返回的查询项的数量,添加了一个精确匹配方法,并添加一个缓存方法来在查询之前存储对计算机的引用。

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 & "rootcimv2")
'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

最新更新