如何防止多个用户编辑同一Excel文件?

时间:2018-10-30 10:33:16

标签: excel vba excel-vba

无论何时使用特定的Excel文件,我都希望阻止其他任何人对其进行编辑。 即。 “该文件当前正在由John Dow编辑,它将立即关闭”。

我正在寻找简单的东西。 有什么想法吗?

谢谢你, D。

1 个答案:

答案 0 :(得分:0)

我将为此添加一个答案,我要说的还远远不够完美(公然地尝试避免因做不必要的事情而投下反对票)。
我只是想看看您是否可以提取打开它的人的名字-毕竟,它通常会给出您第一次打开工作簿时被锁定以便编辑的人的名字。 。

当您打开Excel文件时,将在同一文件夹中创建一个隐藏的锁定文件。锁定文件的名称与原始文件的名称相同,并在文件名的前面附加了~$
我发现您遇到FileCopy错误时无法使用VBA Permission denied复制锁定文件,但是可以使用FileSystemObject CopyFile

我的方法背后的想法是复制锁定文件并将其更改为文本文件。然后,您可以从中提取用户名,并将其与当前用户名进行比较-如果不同,则报告该问题并关闭文件。

注意-我不会在项目中使用它,因为似乎有一些地方可以掉下来,Excel通常会告诉您其他人仍然可以打开它。这更像是编码练习。

Private Sub Workbook_Open()

    Dim ff As Long
    Dim sLockFile As String
    Dim sTempFile As String
    Dim oFSO As Object
    Dim XLUser As String, LoggedUser As String
    Dim fle As Object

    sLockFile = ThisWorkbook.Path & Application.PathSeparator & "~$" & ThisWorkbook.Name
    sTempFile = Replace(sLockFile, "~$", "") & "tmp.txt"

    'Create copy of lock file as a text file.
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    oFSO.CopyFile sLockFile, sTempFile, True

    'Read the first line from the text file.
    ff = FreeFile()
    Open sTempFile For Input Lock Read As #ff
    Line Input #1, XLUser
    Close ff

    'Remove the current user from the text.
    'Need to check this so that it doesn't close because it sees the current user name.
    XLUser = Replace(XLUser, Application.UserName, "")

    'Extract name from text string.
    'There is a double space in the InStr section.
    'The double exclamation mark is a single character - I don't know the code though.
    'Unicode U+0203C I think.
    XLUser = Replace(Left(XLUser, InStr(XLUser, "  ") - 1), "", "")

    'Remove hidden attributes so temp file can be deleted.
    Set fle = oFSO.GetFile(sTempFile)
    fle.Attributes = 0
    Kill sTempFile

    'If there's still text then it's a user name - report it and close.
    If Len(Trim(XLUser)) > 0 Then
        MsgBox "Workbook is already open by " & XLUser
        ThisWorkbook.Close SaveChanges:=False
    End If

End Sub  

放了所有这些,此代码可能更安全:

Private Sub Workbook_Open()

    If ThisWorkbook.ReadOnly Then
        MsgBox "Is opened in read only.", vbOKOnly
        ThisWorkbook.Close SaveChanges:=False
    End If

End Sub