Excel防多用户同时打开宏异常：关闭后重复弹出已打开提示

问题根源 #

1. 缺少工作簿关闭时的锁定文件清理逻辑，导致关闭Sheet.xlsx后，Sperre.txt锁定文件仍残留，触发后续锁定检测循环
2. Workbook_Open中检测到有效锁定并关闭工作簿后，代码仍会执行Call Sperren，错误创建新锁定文件，加剧循环问题
3. 未终止关闭操作后的代码执行，引发意外行为

修复后的完整代码 #

将以下代码替换原ThisWorkbook模块中的内容：

Private Sub Workbook_Open()
    Dim vSperrFile As String
    Dim vDNr As Integer
    Dim vZeit As String
    Dim vSperrFileExists As Boolean
    Dim lockDuration As Integer ' 锁定时长（分钟）

    lockDuration = 30 ' 可根据需求调整锁定有效时长
    vSperrFile = ThisWorkbook.Path & "\Sperre.txt"
    vDNr = FreeFile

    On Error Resume Next
    Open vSperrFile For Input As vDNr
    vSperrFileExists = Err.Number = 0
    On Error GoTo 0

    If vSperrFileExists Then
        Input #vDNr, vZeit ' 读取锁定截止时间
        Close vDNr
        If CDate(vZeit) > Now Then
            MsgBox "文件正由其他员工编辑！"
            ThisWorkbook.Close SaveChanges:=False
            Exit Sub ' 终止后续代码，避免错误创建新锁定
        Else
            ' 锁定已过期，删除旧锁定文件
            Kill vSperrFile
        End If
    End If

    ' 创建新锁定
    Call Sperren(lockDuration)
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim vSperrFile As String
    vSperrFile = ThisWorkbook.Path & "\Sperre.txt"

    On Error Resume Next
    ' 关闭工作簿时自动删除锁定文件，释放权限
    Kill vSperrFile
    On Error GoTo 0
End Sub

Private Sub Sperren(lockMinutes As Integer)
    Dim vSperrFile As String
    Dim vDNr As Integer
    Dim vExpireTime As String

    vSperrFile = ThisWorkbook.Path & "\Sperre.txt"
    vDNr = FreeFile
    ' 生成标准格式的锁定截止时间
    vExpireTime = Format(Now + TimeSerial(0, lockMinutes, 0), "yyyy-mm-dd hh:mm:ss")

    Open vSperrFile For Output As vDNr
    Print #vDNr, vExpireTime
    Close vDNr
End Sub

关键修复点 #

• 新增Workbook_BeforeClose事件：工作簿关闭时自动删除锁定文件，彻底释放权限，避免残留锁定触发重复检测
• 添加Exit Sub终止代码：检测到有效锁定并关闭工作簿后，立即停止后续代码执行，防止错误创建新锁定
• 处理过期锁定：自动清理已过期的锁定文件，确保新用户可以正常获取编辑权限
• 标准化时间格式：使用固定格式写入锁定时间，避免CDate转换时出现异常
• 错误捕获处理：删除锁定文件时添加错误捕获，避免因文件权限问题导致关闭失败

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