How to check if file is open by other user nas gotot if so:

[gman1979]

Hi Guy's,

I've got a form where the user inputs information into 2 textboxes. Then selects save. This opens another workbook, writes the info into the next blank line, saves it, and then closes it. This all works fine.

As this file is on a network, I’m trying to pre-empt any possible issue, mainly multi user access issues. I have decided on the following action.

Check if the file is open, if so give the user the option to retry to save or cancel action completely. If file is not open then open, write to and then save and close it.

I’ve got the code checking if the workbook is open, and seem's to work perfectly when the other workbook is open, i.e. displays messages and performs task as per the above. the issue is when the save button is selected at the exact same time by two or more users, instead of giving one priority and the other the message advising the file is already in use, excel advises that this file already exists (the file being written to) and do you want to replace it, if no is selected the user then gets the "file available for editing" dialogue box as if they have selected notify when opening the file which is read only.

below is my code, I’m hoping that someone will be able to help me, so far I can't find anything in excel help about this that helps or on this forum yet either.

Cheers in advance.

Code:
'***************************************************************
Function IsFileOpen(FileName As String)
Dim iFilenum As Long
Dim iErr As Long

On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0

Select Case iErr
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error iErr
End Select

End Function
'***************************************************************
Private Sub CommandButton5_Click()
'**********************************************************************
Dim iResponse As Integer
'**********************************************************************
If TextBox1.Value = "" Then
MsgBox "please enter Date", vbInformation
TextBox1.SetFocus
Exit Sub
End If
If TextBox2.Value = "" Then
MsgBox "please enter Weekday", vbInformation
TextBox2.SetFocus
Exit Sub
End If
If TextBox3.Value = "" Then
MsgBox "please enter Month", vbInformation
TextBox3.SetFocus
Exit Sub
End If
'**********************************************************************
'check to see if file is already opne on the network
'**********************************************************************
CheckMe:
If Not IsFileOpen("P:\MultiwRITE - Test\9th dec test\2.xls") Then
GoTo AddMe
Else
GoTo FileOpen:
End If
'********************************************************************************
'AddMe: opens the workbook and writes the entered info into the cells of wb 2.xls
'********************************************************************************
AddMe:
Workbooks.Open FileName:="P:\MultiwRITE - Test\9th dec test\2.xls"
Cells.Select
ActiveWindow.WindowState = xlMinimized
Workbooks("2.xls").Activate
Worksheets("1").Select
'***********************************************************
'checks if the wb has opened as ready only and closes it
'if it has
'***********************************************************
If ActiveWorkbook.ReadOnly = True Then
ActiveWorkbook.Close False
Exit Sub
End If
'*******************************************************
'writes to workbook 2.xls
'*******************************************************
Set lastrow = Worksheets("1").Range("a65000").End(xlUp)
lastrow.Offset(1, 0).Value = TextBox1.Text
lastrow.Offset(1, 1).Value = TextBox2.Text
lastrow.Offset(1, 2).Value = TextBox3.Text
lastrow.Offset(1, 3).Value = Date
lastrow.Offset(1, 4).Value = Time
lastrow.Offset(1, 5).Value = Environ("username")
'***************************************************
'Saves workbook and closes it
'***************************************************
ActiveWorkbook.Save
ActiveWorkbook.Close False
MsgBox "File Saved", vbInformation
'***************************************
'blanks out the textboxes on userform
'and sets focus to textbox1
'***************************************
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox1.SetFocus
Exit Sub 'End of AddMe:
'********************************************************************************
'FileOpen: advises the user that wb alreasdy open, gives them option to retry
'********************************************************************************
FileOpen:
iResponse = MsgBox("file currently in use... would you like to try again?", vbYesNo, "Unable to Add File")
If iResponse = vbNo Then
MsgBox "File Not Saved, Please Try Again Later...", vbOKOnly, "Saved Cancelled"
Exit Sub
End If
If iResponse = vbYes Then
GoTo CheckMe
End If
'********************************************************************************
End Sub

 

[gman1979]

Hi Guy's,

Noticed quite a few folk had looked over this thread, so thought i'd post the solution i found to the problem i described in my original thread.

within the section of code titled:
'***********************************************************
'checks if the wb has opened as ready only and closes it
'if it has
'***********************************************************

i added the following code before the end of the if statement:

ActiveWorkbook.ChangeFileAccess notify = False
GoTo FileOpen

this now works perfectly and disabled the notify problem i was having.

hope this is of use to anyone that's had a look over this already.

Cheers

Gman