VBA code to prompt message " file in use" please wait

[mml]

Hi all
I have a user form that multiple people will access from a network folder
As I want them to use this form and only this form I need to have an msg prompt that states something along the lines of " file in use by another user" or similar if the file is being used by someone else
I had found some code that even logged who had the file open but cant seem to find again
Also posted this request in another thread but was advised that as this si a new question best to start new thread
I have attached my user form
Hoping that someone can assist

[Dave]

In the abscence of other replies, I'll provide you this code. I'll caution you that this
code uses the copyfile error and will copy/replace the file you're checking if it is not open. If the file
you're checking is open then no changes to the checked file will occur. I would suggest testing
the code on a test file and/or backing up your checked file before trialling the code. HTH. Dave

Public Function IsFileinUse(CheckFile As String) As Boolean
Dim OfsObj As Object, TempNamestr As String
Dim TempArr As Variant, FileExt As String
TempNamestr = ThisWorkbook.Path & "\" & ThisWorkbook.Name
TempArr = Split(CheckFile, ".")
FileExt = TempArr(1)
Set OfsObj = CreateObject("Scripting.FilesystemObject")
'copy checkfile to temp file
OfsObj.CopyFile CheckFile, _
ThisWorkbook.Path & "\" & Temp & "." & FileExt, True
'trial copy file to checkfile
On Error Resume Next
OfsObj.CopyFile TempNamestr, CheckFile, True
'if file is open
If Err.Number <> 0 Then
On Error GoTo 0
IsFileinUse = True
Else
'file closed copy temp back to check file
On Error GoTo 0
IsFileinUse = False
OfsObj.CopyFile ThisWorkbook.Path & "\" & Temp & "." & FileExt, _
CheckFile, True
DoEvents
'remove temp file
Kill ThisWorkbook.Path & "\" & Temp & "." & FileExt
End If
Set OfsObj = Nothing
End Function
To operate...

If IsFileinUse("C:\yourfoldername\testfilename.xlsm") Then
MsgBox "FILE IN USE!"
End If

[Dave]

I just came across this thread here that is likely a better and safer way to determine a file is open. There's also some learned discussion for informational purposes. HTH. Dave
https://www.mrexcel.com/board/threads/determin-if-a-workbook-is-already-opened-by-another-user.77399/page-2

[Paul_Hossler]

I seems like you're allowing the WB to open in shared mode

If you only want one person using it, could you just save it on the network as a normal workbook?

I think a second user would get "Access Denied" error message if they tried to open it while it was in use

[mml]

Hi Paul and Dave
Thank you for your replies . Paul absolutely correct on a network and a non shared file it does come up with access denied ""or like "file is read only ". Just goes to show that you can over think it !
The code for "file in use" I can use for another project so thanks for taking the time to respond.
Appreciate your assistance.

[Paul_Hossler]

Only downside is someone opening the WB and then taking a long lunch

You could force a close


In Standard Module



Option Explicit


Const AllowedOpening As String = "00:15:00"
Const AllowedWait As Long = 15


Public TimeToClose As Date


'called by OnTime to close the WB
Sub CloseWorkbook()

ThisWorkbook.Close True


End Sub


'-------------------------------------------------------------------------------------- Timer Subs
Sub StartTimer()
'save the initial open duration
TimeToClose = Now + TimeValue(AllowedOpening)

'schedule an automatic close
Application.OnTime TimeToClose, "CloseWorkbook", TimeToClose + AllowedWait, True
End Sub


Sub StopTimer()
'false means clear OnTime
On Error Resume Next
Application.OnTime TimeToClose, "CloseWorkbook", TimeToClose + 15, False
On Error GoTo 0
End Sub


Sub RestartTimer()
Call StopTimer
Call StartTimer
End Sub



In Workbook module




Option Explicit




Private Sub Workbook_Open()
Call StartTimer
End Sub


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'WB changed so clear old automatic close
Call RestartTimer
End Sub




Private Sub Workbook_AfterSave(ByVal Success As Boolean)
'clear old automatic close
Call RestartTimer
End Sub


Private Sub Workbook_Activate()
Call RestartTimer
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call StopTimer
End Sub