如何在虚拟机中仅统计当前VM内的Excel实例数量？

需求背景 #

监控任务管理器，当第三方程序生成Excel工作簿"Book1"时触发事件，以便保存并处理该工作簿。原有VBA代码可在物理机正常统计Excel实例，但在共享服务器的VM中运行时，会统计所有VM的Excel实例，导致误报。

原代码 #

Option Explicit

Function ExcelsCount() As Integer
    Dim objWMIService As Object            'SWbemServicesEx
    Dim objItem As Variant                 'SWbemObjectEx
    Dim colItems As Variant                'SWbemObjectSet
    Dim colItems_Count As Integer
    
    colItems_Count = 0
    Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
    Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process where caption='excel.exe'", , 48)
    For Each objItem In colItems
        'Debug.Print "ID, Name: " & objItem.ProcessId, objItem.Name
        colItems_Count = colItems_Count + 1
    Next
    ExcelsCount = colItems_Count
End Function

问题细节 #

• 运行环境：与其他VM共用同一服务器的虚拟机
• 当前代码问题：统计服务器上所有VM的Excel实例，其他VM打开Excel时触发误报
• 已尝试：通过CommandLine过滤"/automation -Embedding"可减少误报，但无法支持多VM同时运行
• 已获取的Win32_Process属性（示例）：

Caption                     EXCEL.EXE
CommandLine                 Null
CreationClassName           Win32_Process
CreationDate                20250722150424.693842+060
CSCreationClassName         Win32_ComputerSystem
CSName                      [HOST SERVER NAME]
Description                 EXCEL.EXE
ExecutablePath              Null
ExecutionState              Null
Handle                      24908
HandleCount                 1433 
InstallDate                 Null
KernelModeTime              419375000
MaximumWorkingSetSize       Null
MinimumWorkingSetSize       Null
Name                        EXCEL.EXE
OSCreationClassName         Win32_OperatingSystem
OSName                      Microsoft Windows Server 2019 Datacenter|C:\WINDOWS|\Device\Harddisk0\Partition2
OtherOperationCount         88627
OtherTransferCount          12069015
PageFaults                  1915058 
PageFileUsage               228404 
ParentProcessId             24376 
PeakPageFileUsage           351220 
PeakVirtualSize             1235791872
PeakWorkingSetSize          460484 
Priority                    8 
PrivatePageCount            233885696
ProcessId                   24908 
QuotaNonPagedPoolUsage       171 
QuotaPagedPoolUsage          1510 
QuotaPeakNonPagedPoolUsage   178 
QuotaPeakPagedPoolUsage      1615 
ReadOperationCount          111688
ReadTransferCount           19469838
SessionId                   13 
Status                      Null
TerminationDate             Null
ThreadCount                 32 
UserModeTime                818750000
VirtualSize                 1091997696
WindowsVersion              10.0.17763
WorkingSetSize              372477952
WriteOperationCount         775
WriteTransferCount          5332090

解决方案 #

方案1：通过会话ID（SessionId）过滤 #

每个VM通常对应独立的Windows会话，可先获取当前进程的SessionId，再过滤同会话的Excel进程：

Option Explicit

Private Declare PtrSafe Function GetCurrentProcessId Lib "kernel32" () As LongPtr
Private Declare PtrSafe Function ProcessIdToSessionId Lib "kernel32" (ByVal dwProcessId As LongPtr, ByRef pSessionId As Long) As Long

Function ExcelsCount() As Integer
    Dim objWMIService As Object
    Dim objItem As Variant
    Dim colItems As Variant
    Dim colItems_Count As Integer
    Dim currentSessionId As Long
    Dim currentPid As LongPtr
    
    ' 获取当前进程的会话ID
    currentPid = GetCurrentProcessId()
    ProcessIdToSessionId currentPid, currentSessionId
    
    colItems_Count = 0
    Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
    ' 过滤同会话的Excel进程
    Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process where caption='excel.exe' AND SessionId=" & currentSessionId, , 48)
    
    For Each objItem In colItems
        colItems_Count = colItems_Count + 1
    Next
    ExcelsCount = colItems_Count
End Function

说明：该方案利用Windows会话隔离特性，每个VM的运行会话独立，因此同会话的Excel进程必然属于当前VM。

方案2：通过进程的可执行路径（ExecutablePath）过滤 #

若VM的系统盘路径与其他VM或宿主机不同，可通过Excel进程的ExecutablePath匹配当前VM的路径：

Option Explicit

Function ExcelsCount() As Integer
    Dim objWMIService As Object
    Dim objItem As Variant
    Dim colItems As Variant
    Dim colItems_Count As Integer
    Dim currentExcelPath As String
    
    ' 获取当前Excel实例的可执行路径（代表当前VM的Excel路径）
    currentExcelPath = Application.Path & "\EXCEL.EXE"
    
    colItems_Count = 0
    Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
    ' 过滤路径匹配的Excel进程
    Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process where caption='excel.exe' AND ExecutablePath='" & Replace(currentExcelPath, "\", "\\") & "'", , 48)
    
    For Each objItem In colItems
        colItems_Count = colItems_Count + 1
    Next
    ExcelsCount = colItems_Count
End Function

说明：需确保ExecutablePath属性可正常获取（部分场景下可能为Null，需提前验证）。

关于SWbem类型库 #

SWbem相关对象的类型库名称为Microsoft WMI Scripting V1.2 Library，可通过VBA编辑器的「工具」→「引用」添加，添加后可使用强类型声明（如Dim objWMIService As SWbemServicesEx），便于查看属性和方法。

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