时间戳

首页 > 解决方案 > 如何防止多个用户编辑同一个 Excel 文件？

excel - 如何防止多个用户编辑同一个 Excel 文件？

问题描述

每当使用特定的 Excel 文件时，我都想阻止其他人对其进行编辑。IE。“此文件目前正在由 John Dow 编辑，现在将关闭”。

我正在寻找简单的东西。有任何想法吗？

谢谢你，D。

标签： excelvba

解决方案

我将为此添加一个答案，我不得不说它远非完美（公然试图避免因尝试做一些不必要的事情而投反对票）。
我只是想看看你是否可以提取打开它的人的名字——毕竟，当你第一次打开工作簿时，它通常会给出锁定它以进行编辑的人的名字。

当您打开 Excel 文件时，会在同一文件夹中创建一个隐藏的锁定文件。锁定文件与原始文件具有相同的名称，并~$附加在文件名的前面。
我发现您无法使用 VBA 复制锁定文件，FileCopy因为您遇到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

推荐阅读