autosave and read only issues

sideburnsurfer79

New Member
Joined
Mar 8, 2010
Messages
7
Hi all. First post so please be kind. After searching this site and it seems, the entire of google, I have accepted defeat and I come to you cap in hand.

I have an excel workbook (2003) that around 5/6 people have access to. I wanted some version control auto saving and found a macro to do what I wanted and this part of the code works fine. However, the other bit does not.

I would like for the following to happen:
If someone is already in the workbook, it will usually give a message box that gives the option of 'read-only', 'notify' or 'cancel'. I don't want this to happen. I do not want anyone to be able to view a read only if someone is viewing it already. I found a code that looks like it should work but I just can't stop the 'read-only', 'notify' or 'cancel' box appearing and replacing it with my message box.

The full code is:
---------------------------

Private Sub Workbook_Open()
Dim blnReadonly As Boolean

blnReadonly = ThisWorkbook.ReadOnly

If blnReadonly = True Then
MsgBox ("Another user is currently working with this. Please pop back later")
Application.Quit

End If
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
With ActiveWorkbook
.Save
filepath = .Path
.SaveAs filepath & "\Jobstatus" & Date$ & Timer & ".xls"
.Close
End With

End Sub
--------------------------

Any help, suggestions are more than welcome. Thanks in advance

Tom
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Hi Tom and welcome to the board.

It seems to me that your code in the Workbook_Open event does the job already as it prevents the workbook from being open read only.

If you don't want to see the read only message prompt it's gonna be difficult . The only way I can think of is to use a hook in an addin but that would be more trouble that it is worth.

Regards.
 
Upvote 0
Thanks Jaafar,

You're right, it does work when I click on read only. (I hadn't gone that far stupidly). Is there a code to do exactly the same thing when someone clicks on Notify? I tried guessing the code and replacing anywhere it said 'readonly' to 'notify' but that didn't work.

Thanks in advance

Tom
 
Upvote 0
Thanks Jaafar,

You're right, it does work when I click on read only. (I hadn't gone that far stupidly). Is there a code to do exactly the same thing when someone clicks on Notify? I tried guessing the code and replacing anywhere it said 'readonly' to 'notify' but that didn't work.

Thanks in advance

Tom

I don't think you can do that without a labourious hook code. The reason being the ReadOnly message prompt fires before the Workbook_Open event so you don't get a chance to run any VBA code to dismiss the Prompt or emulate a click on the Notify button.

Maybe you could try placing a running loop inside an addin that would continiously check for the existence of the ReadOnly Prompt and if it is there send a click to the Notify button. But then again that would have a slight hit on performance and would require the addin to be installed on each machine .

Regards.
 
Upvote 0
Here is another approach that will ensure that while the target workbook is open no other user will be able to open it ReadOnly from anywhere on the network and without even letting the ReadOnly Prompt appear on their screen.

here is the trick :

Create an intermediate workbook- One copy on each of the users PCs. The sole job of this intermediate workbook will be to check if the target workbook is already open or not and act accordingly then quietly close itself. All done via the following code :

Code goes in the ThisWorkbook module of the intermediate workbook.

Code:
Option Explicit
 
Private Const FILE_TO_OPEN As String = _
"C:\Target.xls" [COLOR=seagreen]'change the PathFileName as required.[/COLOR]
 
Private Sub Workbook_Open()
 
    Application.DisplayAlerts = False
 
    Me.Windows(1).Visible = False
 
    If IsFileOpen(FILE_TO_OPEN) Then
        MsgBox ("Another user is currently working with this." _
        & vbCrLf & "Please pop back later"), vbCritical
    Else
        Workbooks.Open FILE_TO_OPEN
    End If
 
    Application.DisplayAlerts = True
 
    Me.Close False
 
End Sub
 
Private Function IsFileOpen(sPathFileName As String) As Boolean
 
    Dim hdlFile As Long
    On Error GoTo FileIsOpen:
    hdlFile = FreeFile
    Open sPathFileName For Random Access Read Write _
    Lock Read Write As hdlFile
    Close hdlFile
    Exit Function
FileIsOpen:
    IsFileOpen = True
    Close hdlFile
 
End Function

Optionnally, you can give this inetermediate workbook the name of your target workbook (to avoid confusion) and if you want, you can also prevent any acidental access to the target workbook by hiding it from view via the explorer folder options.

The users won't be aware of anything that is happening and won't have to deal with the annoying ReadOnly prompt.

Regards.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,848
Members
452,361
Latest member
d3ad3y3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top