How would I prevent multiple users from editing the same Excel file? - excel

Question

Whenever a specific Excel file is in use, I'd like to prevent anyone else editing it.
ie. "This file is currently being edited by John Dow, and it will now close".
I'm looking for something simple.
Any ideas?
Thank you,
D.

Answer 1

I'm going to add an answer to this which I'll have to say is nowhere near perfect (blatantly trying to avoid down-votes for trying to do something that isn't really necessary).
I just wanted to see if you could extract the name of the person that has it open - after all, it does normally give the name of the person who has it locked for editing when you first open a workbook.
When you open an Excel file a hidden lock file is created in the same folder. The lock file has the same name as the original with ~$ appended to the front of the file name.
I found you can't copy the lock file using the VBA FileCopy as you get a Permission denied error, but you can using the FileSystemObject CopyFile.
The thinking behind my method is to copy the lock file and change it to a text file. You can then pull the user name from it and compare it against the current user name - if it's different then report that and close the file.
Note - I wouldn't use this in a project as there seems to be a few places it can fall over, and Excel will generally tell you that someone else has it open anyway. It was more of a coding exercise.
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
Having put all that, this code is probably safer:
Private Sub Workbook_Open()
If ThisWorkbook.ReadOnly Then
MsgBox "Is opened in read only.", vbOKOnly
ThisWorkbook.Close SaveChanges:=False
End If
End Sub