>
0 items - $0.00

Your shopping cart is empty

Why not add some items in our Shop
Call Us at +27 21 786 1224

Multi-user prevention on Dropbox

by Brilliance Computer Training Academy & Services

Often we sit with the situation where we have multiple users adding data to workbooks. We want to prevent more than one user to open the same workbook so that one person does not overwrite the changes of another.

When we are on a network, the code below will work. But this is not the case in Dropbox.

Private Sub Workbook_Open()
If ThisWorkbook.ReadOnly Then
MsgBox "This File is already in use. " & Chr(13) & Chr(13) & "Multiple users are not allowed at one point in time." & Chr(13) & Chr(13)
ThisWorkbook.Close savechanges:=False
End If
End Sub

Shared folders in Dropbox will still allow multi-users to open the same workbook and when one user saves his file while another is still open Dropbox will now display two files like this:

MyFile (Jenny's conflicted copy 2016-02-24).xlsm

MyFile.xlsm

 

To resolve this problem, we insert code in the auto_open procedure which creates a text file in the same directory. The auto_open procedure will then also have code which checks if this text file exists. If this text file does exist, an error message will be displayed notifying a second user that this file is already open. When the first user closes his file, there must be an auto-close procedure which then deletes this text file again. The code below does just that.

Option Explicit

 

Sub auto_open()
Dim fs As New FileSystemObject

If fs.FileExists(ActiveWorkbook.Path & "\oFlg.f") Then
MsgBox "This file is open by another user ..." 'can also get name out of text file if u want to display it here
'close without deleting the flag file
Application.DisplayAlerts = False
ActiveWorkbook.Close False
Application.DisplayAlerts = True
Else
createOpenFlag
End If

Set fs = Nothing

End Sub

 

Function createOpenFlag()
Dim fs As New FileSystemObject
Dim txtf As Object
Set txtf = fs.CreateTextFile(ActiveWorkbook.Path & "\oFlg.f", True) 'probably better to have this flag file somewhere in another folder so users dont mess with it
txtf.WriteLine Environ$("Username")
Set fs = Nothing
End Function

 

Sub auto_close()
On Error Resume Next
Kill ActiveWorkbook.Path & "\oFlg.f"
End Sub

Share this article

Leave a comment

Your email address will not be published. Required fields are marked *