Excel实例隔离需求：VBA工具独立运行及外部工作簿分流问题

问题根源 #

你提供的原代码存在两个核心问题：

• oAppEvents_WorkbookOpen 里的 If Wb Is Me Then Exit Sub 判断逻辑错误，Me 在这里指代类模块而非工作簿，导致拦截自身打开操作时出错，进而触发关闭逻辑。
• OnTime 异步调用易引发实例状态混乱，导致工具所在工作簿被误关闭。

实现步骤与代码 #

1. 创建应用事件类模块

插入一个类模块（命名为 clsAppEvents），用于捕获Excel应用的新建、打开工作簿事件：

Option Explicit

Public WithEvents App As Application

Private Sub App_NewWorkbook(ByVal Wb As Workbook)
    ' 只处理非工具所在的新建工作簿
    If Not Wb Is ThisWorkbook Then
        Dim newApp As Application
        Set newApp = New Application
        newApp.Visible = True
        ' 关闭当前实例的新建工作簿，在新实例新建
        Wb.Close SaveChanges:=False
        newApp.Workbooks.Add
        Set newApp = Nothing
    End If
End Sub

Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
    ' 跳过工具自身的打开事件
    If Wb Is ThisWorkbook Then Exit Sub
    
    Dim newApp As Application
    Set newApp = New Application
    newApp.Visible = True
    
    ' 只读模式打开避免文件锁定，然后在新实例打开原文件
    Wb.ChangeFileAccess Mode:=xlReadOnly
    newApp.Workbooks.Open Filename:=Wb.FullName
    ' 关闭当前实例的外来工作簿
    Wb.Close SaveChanges:=False
    Set newApp = Nothing
End Sub

2. 在ThisWorkbook模块实现启动逻辑与事件绑定

打开 ThisWorkbook 模块，添加以下代码，实现启动时的实例隔离，以及运行时的事件监听：

Option Explicit

Private appEvents As clsAppEvents

Private Sub Workbook_Open()
    ' 步骤1：检查当前是否已有其他Excel实例，决定是否在新实例打开自己
    Dim existingInstances As Object
    On Error Resume Next
    Set existingInstances = GetObject(, "Excel.Application").Workbooks
    On Error GoTo 0
    
    ' 如果存在其他工作簿（排除自身），则在新实例打开当前工具并关闭当前实例的副本
    If Not existingInstances Is Nothing Then
        If existingInstances.Count > 1 Or (existingInstances.Count = 1 And Not existingInstances(1) Is ThisWorkbook) Then
            Dim newApp As Application
            Set newApp = New Application
            newApp.Visible = True
            ' 在新实例打开当前工具
            newApp.Workbooks.Open Filename:=ThisWorkbook.FullName
            ' 关闭当前实例的工具副本
            ThisWorkbook.Close SaveChanges:=False
            Set newApp = Nothing
            Exit Sub
        End If
    End If
    
    ' 步骤2：绑定应用事件，阻止其他工作簿进入当前实例
    Set appEvents = New clsAppEvents
    Set appEvents.App = Application
    
    ' 确保当前实例只有本工具工作簿
    Dim wb As Workbook
    For Each wb In Application.Workbooks
        If Not wb Is ThisWorkbook Then
            Dim tempApp As Application
            Set tempApp = New Application
            tempApp.Visible = True
            tempApp.Workbooks.Open Filename:=wb.FullName
            wb.Close SaveChanges:=False
            Set tempApp = Nothing
        End If
    Next wb
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' 清理事件绑定
    Set appEvents.App = Nothing
    Set appEvents = Nothing
End Sub

代码说明 #

• 启动隔离：打开工具时，检查系统中是否有其他Excel工作簿存在。如果有，自动在新实例打开工具，并关闭当前实例的副本，确保工具从一开始就独占实例。
• 运行时拦截：通过应用事件监听，任何新建或打开的外来工作簿都会被立即转移到新的Excel实例，当前实例始终只保留工具本身。
• 避免误关闭：修正了原代码中对Me的错误引用，明确判断当前工作簿是否为工具本身，防止误操作关闭工具。

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