How do I get excel sheet to check if already open

[ghrek]

Hi

I sort of think this can be done but need to check.

I have a workbook and what I want it to do is when it’s opened by someone I need it to check if it’s already opened by someone else.

If it is I need a message box to come up stating that “FILE IS READ ONLY” and the option just to click OK

Can this be done via macro as not got a clue on how to write it.

 

[Jeffrey Mahoney]

Try this

Sub TestReadonly()
  Dim PFN As String
  Dim WB As Workbook
  Dim OpenStatus As Integer
  
  PFN = "C:\Users\Jeff\Documents\MREXCEL\Book2.xlsm"
  
  OpenStatus = IsFileOpen(PFN)
  
  If OpenStatus = -1 Then   'Open by you with (not read only)
    'Don't run the code
  ElseIf OpenStatus = 3 Then    'Open by you as read only
    Set WB = Workbooks.Open(PFN, ReadOnly:=False, Password:="new", WriteResPassword:="new")
    'Run the code
  ElseIf OpenStatus = 1 Then
    'Somebody else has it open
  ElseIf OpenStatus = 0 Then
    'The file is not open by anybody
  End If
  
End Sub

'Check to see if current user has file open
Function IsWBOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
    On Error Resume Next
    IsWBOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function




'Checks to see if file is open by another user or by current user
Function IsFileOpen(PathFilename As String) As Integer
    Dim filenum As Integer, errnum As Integer


    On Error Resume Next    ' Turn error checking off.
    filenum = FreeFile()    ' Get a free file number.
    
                            ' Attempt to open the file and lock it.
    Open PathFilename For Input Lock Read As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=filenum]#filenum[/URL] 
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.


    ' Check to see which error occurred.
    Select Case errnum


        ' No error occurred.
        ' File is NOT already open by another user.
        Case 0
          If IsWBOpen(GetFileName(PathFilename)) = True Then
            'Open as read only
            IsFileOpen = 3
          Else
            IsFileOpen = 0
          End If


        ' Error number for "Permission Denied."
        ' File is already opened by another user.
        Case 70
            If IsWBOpen(GetFileName(PathFilename)) = True Then
              IsFileOpen = -1                               'Open by this user
            Else
              IsFileOpen = 1                                'Open by another user
            End If


        ' Another error occurred.
        Case Else
            Error errnum
    End Select


End Function

 

[ghrek]

Sorry do I copy that into the excel file that im trying to open in "open workbook" function?

 

[Jeffrey Mahoney]

Those can be called by a different workbook or within the workbook you need to test. My question is, since Excel let's you know when somebody else has that workbook open, why would you need any test at all. I thought you wanted to test if a WB was open from another WB.