检查指定应用程序是否正在运行的 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" 库的引用。你可以通过以下步骤来完成:

  1. 打开 Visual Basic 编辑器(在 Excel 中按下 Alt+F11)。
  2. 在 "工具" 菜单中选择 "引用"。
  3. 在 "引用" 对话框中找到并选中 "Microsoft Windows Common Controls 6.0"。
  4. 单击 "确定" 按钮保存更改。
posted @ 2024-06-12 14:29  梓涵VV  阅读(5)  评论(0编辑  收藏  举报