如何通过VBA检测共享工作簿是否被其他用户占用并阻止以只读模式打开

咱们先梳理下你原代码里的几个关键问题，再给出修正后的方案：

1. 工作簿对象赋值错误：直接把文件路径赋值给Workbook对象（Set book = "\\路径..."）是无效的，必须通过Workbooks.Open方法来创建并获取工作簿对象。
2. 未定义的对象调用：app.Quit()里的app没有定义，而且你只是想关闭目标工作簿，完全不需要退出整个Excel应用程序。
3. 逻辑顺序问题：应该先尝试打开工作簿，再检测它是否处于只读状态，而不是先赋值路径再判断。

下面给你两种可行的解决方案，你可以根据需求选择：

方案一：尝试打开后检测只读状态 #

这个方案会先尝试以编辑模式打开目标工作簿，如果文件被其他用户占用，Excel会自动以只读模式打开，我们再通过ReadOnly属性判断并给出提示：

修正后的完整代码 #

Sub MenuSuspenso()
    ' 重置右键单元格菜单
    Application.CommandBars("Cell").Reset
    
    ' 隐藏所有默认控件（如果不需要隐藏默认选项，可删除这段循环）
    Dim cbc As CommandBarControl
    For Each cbc In Application.CommandBars("Cell").Controls
        cbc.Visible = False
    Next cbc
    
    ' 添加自定义右键菜单选项
    With Application.CommandBars("Cell").Controls.Add(Temporary:=True)
        .Caption = "AQUAS"
        .OnAction = "AQUAS"
    End With
End Sub

Sub AQUAS()
    Dim targetPath As String
    Dim targetBook As Workbook
    
    ' 目标工作簿路径
    targetPath = "\\T\Public\DOCS\Hualley\FLUXO CAIXA HINDY - 111.xlsm"
    
    ' 禁用屏幕更新，让操作更流畅
    Application.ScreenUpdating = False
    
    ' 捕获文件不存在或无法打开的错误
    On Error Resume Next
    ' 尝试以编辑模式打开，指定更新外部链接、启用宏，关闭Excel自带的占用提示
    Set targetBook = Workbooks.Open( _
        Filename:=targetPath, _
        UpdateLinks:=xlUpdateLinksAlways, _
        ReadOnly:=False, _
        Notify:=False, _
        EnableMacros:=True ' 确保启用工作簿宏
    )
    On Error GoTo 0 ' 恢复默认错误处理
    
    ' 检查是否成功打开工作簿
    If targetBook Is Nothing Then
        MsgBox "无法打开文件：文件不存在或被其他用户锁定且无法只读访问", vbExclamation
        Application.ScreenUpdating = True
        Exit Sub
    End If
    
    ' 检测是否处于只读模式
    If targetBook.ReadOnly Then
        MsgBox "Arquivo em Uso（文件正在被使用）", vbExclamation
        targetBook.Close SaveChanges:=False ' 关闭只读打开的工作簿，不保存
    End If
    
    Application.ScreenUpdating = True
End Sub

关键说明 #

• 使用Notify:=False可以关闭Excel自带的“文件被占用”提示，由我们自定义的提示替代，体验更好。
• EnableMacros:=True确保打开带宏的工作簿时自动启用宏（如果你的Excel安全设置允许的话）。
• 错误处理部分可以应对文件不存在、权限不足等异常情况。

方案二：提前检测文件是否被锁定 #

如果你想在尝试打开前就判断文件是否被占用，可以用文件系统的方法尝试写入文件，若失败则说明文件被锁定：

完整代码 #

Sub MenuSuspenso()
    ' 重置右键单元格菜单
    Application.CommandBars("Cell").Reset
    
    ' 隐藏所有默认控件（可选）
    Dim cbc As CommandBarControl
    For Each cbc In Application.CommandBars("Cell").Controls
        cbc.Visible = False
    Next cbc
    
    ' 添加自定义右键菜单选项
    With Application.CommandBars("Cell").Controls.Add(Temporary:=True)
        .Caption = "AQUAS"
        .OnAction = "AQUAS"
    End With
End Sub

' 检测文件是否被锁定的辅助函数
Function IsFileLocked(filePath As String) As Boolean
    Dim fileNum As Integer
    Dim errNum As Integer
    
    On Error Resume Next
    fileNum = FreeFile()
    ' 尝试以读写锁定模式打开文件
    Open filePath For Input Lock Read Write As #fileNum
    Close #fileNum
    errNum = Err.Number
    On Error GoTo 0
    
    ' 错误号70代表文件被其他进程锁定
    IsFileLocked = (errNum = 70)
End Function

Sub AQUAS()
    Dim targetPath As String
    Dim targetBook As Workbook
    
    targetPath = "\\T\Public\DOCS\Hualley\FLUXO CAIXA HINDY - 111.xlsm"
    
    ' 先检测文件是否被锁定
    If IsFileLocked(targetPath) Then
        MsgBox "Arquivo em Uso（文件正在被使用）", vbExclamation
        Exit Sub
    End If
    
    ' 禁用屏幕更新
    Application.ScreenUpdating = False
    
    ' 尝试以编辑模式打开工作簿
    On Error Resume Next
    Set targetBook = Workbooks.Open( _
        Filename:=targetPath, _
        UpdateLinks:=xlUpdateLinksAlways, _
        ReadOnly:=False, _
        EnableMacros:=True _
    )
    On Error GoTo 0
    
    If targetBook Is Nothing Then
        MsgBox "无法打开文件：文件不存在或出现未知错误", vbExclamation
    End If
    
    Application.ScreenUpdating = True
End Sub

关键说明 #

• 这个方法在打开前就判断文件状态，避免了先打开只读文件再关闭的操作。
• 注意：如果是Excel设置为共享工作簿（通过“审阅”→“共享工作簿”启用的多人协作模式），这个检测可能会返回锁定状态，但实际上共享工作簿允许多人同时编辑，这种情况下建议用方案一。

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