检查指定应用程序是否正在运行的 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"。
- 单击 "确定" 按钮保存更改。