首页 > 解决方案 > 如何防止打开相同的工作表

问题描述

我有多个通过 Dropbox 共享的工作表。我需要检测文件是否已在另一台设备上打开。

我已经尝试了下面的代码,但问题是每次我打开工作簿时,它都会说文件已打开。

Function IsFileOpen(fileName As String)

Dim fileNum As Integer
Dim errNum As Integer

'Allow all errors to happen
On Error Resume Next
fileNum = FreeFile()

'Try to open and close the file for input.
'Errors mean the file is already open
Open fileName For Input Lock Read As #fileNum
Close fileNum

'Get the error number
errNum = Err

'Do not allow errors to happen
On Error GoTo 0

'Check the Error Number
Select Case errNum

    'errNum = 0 means no errors, therefore file closed
    Case 0
    IsFileOpen = False

    'errNum = 70 means the file is already open
    Case 70
    IsFileOpen = True

    'Something else went wrong
    Case Else
    IsFileOpen = errNum

End Select

End Function
Private Sub Workbook_Open()
Dim fileName As String
fileName = ActiveWorkbook.FullName

'Call function to check if the file is open
If IsFileOpen(fileName) = False Then

    MsgBox "YOU ARE GOOD TO GO"

Else

    'The file is open or another error occurred
    MsgBox " STOP THIS FILE IS ALREADY OPEN."

End If

End Sub

标签: excelvbaexcel-2016

解决方案


推荐阅读