如何用MS Access VBA检测Office应用程序是否已打开？

核心思路 #

针对你的需求，我们需要检测Word/Excel/Outlook应用程序进程是否正在运行，而非特定文档是否打开。以下提供两种实用的VBA实现方案：

1. 使用GetObject快速检测（简单直接） #

利用VBA的GetObject函数尝试绑定到已运行的Office应用实例，成功则说明应用已打开，失败则未运行。

检测Word是否运行

Function IsWordRunning() As Boolean
    Dim objWord As Object
    On Error Resume Next
    Set objWord = GetObject(, "Word.Application")
    On Error GoTo 0
    IsWordRunning = Not (objWord Is Nothing)
    If Not objWord Is Nothing Then Set objWord = Nothing ' 释放对象
End Function

检测Excel是否运行

Function IsExcelRunning() As Boolean
    Dim objExcel As Object
    On Error Resume Next
    Set objExcel = GetObject(, "Excel.Application")
    On Error GoTo 0
    IsExcelRunning = Not (objExcel Is Nothing)
    If Not objExcel Is Nothing Then Set objExcel = Nothing
End Function

检测Outlook是否运行

Function IsOutlookRunning() As Boolean
    Dim objOutlook As Object
    On Error Resume Next
    Set objOutlook = GetObject(, "Outlook.Application")
    On Error GoTo 0
    IsOutlookRunning = Not (objOutlook Is Nothing)
    If Not objOutlook Is Nothing Then Set objOutlook = Nothing
End Function

使用示例：

Sub TestOfficeCheck()
    If IsWordRunning() Then
        MsgBox "Word已处于运行状态"
    Else
        MsgBox "Word未运行"
    End If
End Sub

2. 用Windows API检测进程（精准控制） #

如果需要更底层的进程检测（比如区分多实例场景），可以通过Windows API枚举系统进程，判断目标Office进程是否存在。

首先在模块顶部声明API：

Declare PtrSafe Function EnumProcesses Lib "psapi.dll" ( _
    ByRef lpidProcess As Long, _
    ByVal cb As Long, _
    ByRef cbNeeded As Long) As Long

Declare PtrSafe Function GetModuleBaseName Lib "psapi.dll" Alias "GetModuleBaseNameA" ( _
    ByVal hProcess As LongPtr, _
    ByVal hModule As LongPtr, _
    ByVal lpBaseName As String, _
    ByVal nSize As Long) As Long

Declare PtrSafe Function OpenProcess Lib "kernel32.dll" ( _
    ByVal dwDesiredAccess As Long, _
    ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long) As LongPtr

Declare PtrSafe Function CloseHandle Lib "kernel32.dll" ( _
    ByVal hObject As LongPtr) As Long

Const PROCESS_QUERY_INFORMATION = &H400
Const PROCESS_VM_READ = &H10

然后编写通用检测函数：

Function IsProcessRunning(processName As String) As Boolean
    Dim processIDs() As Long
    Dim cbNeeded As Long
    Dim numProcesses As Long
    Dim i As Long
    Dim hProcess As LongPtr
    Dim processNameBuffer As String
    Dim bufferSize As Long
    Dim retrievedNameLength As Long
    
    ' 初始化进程ID数组
    ReDim processIDs(1023) As Long
    If EnumProcesses(processIDs(0), UBound(processIDs) * 4, cbNeeded) = 0 Then
        IsProcessRunning = False
        Exit Function
    End If
    
    ' 计算实际进程数量
    numProcesses = cbNeeded \ 4
    If numProcesses > UBound(processIDs) Then
        ReDim Preserve processIDs(numProcesses - 1) As Long
        EnumProcesses(processIDs(0), UBound(processIDs) * 4, cbNeeded)
    End If
    
    ' 遍历每个进程
    For i = 0 To numProcesses - 1
        hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, processIDs(i))
        If hProcess <> 0 Then
            processNameBuffer = String(256, vbNullChar)
            bufferSize = 256
            retrievedNameLength = GetModuleBaseName(hProcess, 0, processNameBuffer, bufferSize)
            If retrievedNameLength > 0 Then
                ' 不区分大小写比较进程名
                If LCase(Left(processNameBuffer, retrievedNameLength)) = LCase(processName) Then
                    IsProcessRunning = True
                    CloseHandle hProcess
                    Exit Function
                End If
            End If
            CloseHandle hProcess
        End If
    Next i
    
    IsProcessRunning = False
End Function

使用示例：

Sub TestProcessCheck()
    ' Word进程名：WINWORD.EXE，Excel：EXCEL.EXE，Outlook：OUTLOOK.EXE
    If IsProcessRunning("WINWORD.EXE") Then
        MsgBox "Word进程正在运行"
    Else
        MsgBox "Word进程未运行"
    End If
End Sub

结合Access场景的使用建议 #

• 打开Office应用前先调用检测函数：若应用已运行，直接绑定到现有实例；未运行则创建新实例，避免重复启动报错。
• 关闭应用前先确认进程状态，避免因尝试关闭不存在的实例触发终止/调试提示。
• 注意：用GetObject绑定现有实例后，不要随意调用Quit（除非确认用户无未保存文档）；如果是自己创建的实例，操作完成后记得释放对象并调用Quit。

内容的提问来源于stack exchange，提问作者Ian Bateman