检查指定应用程序是否正在运行的 VBA 宏
' Declare the necessary Windows API functions
Private Declare PtrSafe Function CreateToolhelp32Snapshot Lib "kernel32" ( _
ByVal dwFlags As Long, _
ByVal th32ProcessID As Long) As Long
Private Declare PtrSafe Function Process32First Lib "kernel32" ( _
ByVal hSnapshot As Long, _
ByRef lppe As PROCESSENTRY32) As Long
Private Declare PtrSafe Function Process32Next Lib "kernel32" ( _
ByVal hSnapshot As Long, _
ByRef lppe As PROCESSENTRY32) As Long
Private Declare PtrSafe Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Const TH32CS_SNAPPROCESS As Long = 2
Private Const MAX_PATH As Long = 260
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
' Function to check if APP is running
Function IsAPPRunning(exefilename As String) As Boolean
Dim hSnapshot As Long
Dim pe32 As PROCESSENTRY32
' Take a snapshot of all processes in the system
On Error GoTo ErrorHandler
hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If hSnapshot <> -1 Then
Debug.Print "Snapshot taken successfully."
' Set the size of the PROCESSENTRY32 structure
pe32.dwSize = LenB(pe32)
' Get the first process information
If Process32First(hSnapshot, pe32) <> 0 Then
Debug.Print "First process retrieved successfully."
Do
' Extract the executable file name from the PROCESSENTRY32 structure
If InStr(1, pe32.szExeFile, exefilename, vbTextCompare) > 0 Then
IsAPPRunning = True
Debug.Print exefilename + " found."
CloseHandle hSnapshot
Exit Function
End If
Loop While Process32Next(hSnapshot, pe32) <> 0
Else
Debug.Print "Failed to retrieve the first process."
End If
' Close the handle to the snapshot
CloseHandle (hSnapshot)
Else
Debug.Print "Failed to take snapshot."
End If
IsAPPRunning = False
Debug.Print exefilename + " not found."
Exit Function
ErrorHandler:
Debug.Print "Error: " & Err.Description
IsAPPRunning = False
End Function
代码中的 IsAPPRunning 函数使用了之前提到过的 Windows API 函数,它会遍历系统中的所有进程并检查每个进程的可执行文件名是否与指定的应用程序文件名匹配。如果找到了匹配的进程,则返回 True,否则返回 False。
请注意,在运行代码之前,你需要确保已经添加了对 "kernel32" 库的引用。你可以通过以下步骤来完成:
- 打开 Visual Basic 编辑器(在 Excel 中按下
Alt+F11)。 - 在 "工具" 菜单中选择 "引用"。
- 在 "引用" 对话框中找到并选中 "Microsoft Windows Common Controls 6.0"。
- 单击 "确定" 按钮保存更改。

浙公网安备 33010602011771号