Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Westi on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Check if a file is already open from Excel 4

Status
Not open for further replies.

Stretchwickster

Programmer
Apr 30, 2001
1,746
GB
Currently, I'm using the following code to see if a file is already open. It works fine. However, I now have a shared file and it doesn't detect if this file is already open. Does anyone have a solution regardless of whether the file is shared or exclusive.
Code:
Function FileIsOpen(AFileName As String) As Boolean
   On Error Resume Next
   FileIsOpen = False
   ' If the file is already open & file access is disallowed,
   ' the Open operation fails and an error occurs.
   Open AFileName For Binary Access Read Lock Read As #1
   Close #1
   ' If an error occurs, the file is currently open.
   If Err.Number <> 0 Then
     FileIsOpen = True
     MsgBox &quot;Unable to open &quot; & AFileName & vbCrLf & &quot;A file with this name is already open&quot;, vbExclamation
     Err.Clear
   End If
End Function

Clive [infinity]
Ex nihilo, nihil fit (Out of nothing, nothing comes)
 
Here is one way:
[blue]
Code:
Option Explicit

Sub test()
  If IsWorkbookOpen(&quot;GROUP_sum.xls&quot;) Then
    MsgBox &quot;File &quot;&quot;group_sum.xls&quot;&quot; is open.&quot;
  Else
    MsgBox &quot;File is not open&quot;
  End If
End Sub

Function IsWorkbookOpen(AWorkbookName As String) As Boolean
Dim wkb As Workbook
  For Each wkb In Workbooks
    If UCase(wkb.Name) = UCase(AWorkbookName) Then
      IsWorkbookOpen = True
    End If
  Next wkb
End Function
[/color]

 
bit different for sequential file handling, which I think is the problem here ...

And no, I haven't a clue how to solve it!

 
Unless I'm mistaken, Zathras' approach, while good, is not quite complete. The presence of shared files makes for the possibility that another user may have the file open. To test for this, I have inserted additional code into Zathras' routine that makes use of the workbook.UserStatus array:

Code:
Function IsWorkbookOpen(AWorkbookPathName As String) As Boolean
Dim wkb As Workbook, users As Variant

On Error Resume Next
IsWorkbookOpen = False
   For Each wkb In Workbooks
      If UCase(wkb.Path & &quot;\&quot; & wkb.Name) = UCase(AWorkbookPathName) Then
         IsWorkbookOpen = True
      End If
   Next wkb
   If IsWorkbookOpen = False Then ' See if other user has shared file open
      Set wkb = Workbooks.Open(AWorkbookPathName)
      If Not wkb Is Nothing Then
         users = wkb.UserStatus ' returns an array of user names, access times, and exclusive/shared mode indicator
         If UBound(users, 1) > 1 Then ' multiple users have file open
            IsWorkbookOpen = True
         End If
         wkb.Close
      End If
   End If
End Function

One obvious drawback to this approach is that you must actually open the file to check the .UserStatus property. But it is more accurate overall.

Hope this is helpful!



VBAjedi [swords]
 
Geez, Stretch,

You asked if a FILE was being shared, as opposed to a WORKBOOK, which is a specific kind of file. But from your example code, it sure looked like you were opening a non Excel file for some kind of read/write/random access which is a far sight different than opening another workbook. I spent alot of time working on a NON EXCEL solution.

Please be more specific in the future. :)

Gotta give VBA a STAR!

Skip,
Skip@TheOfficeExperts.com
 
There's no need to loop through all open workbooks. Just try to reference the book by name and check the error code.

(note: this is just to see if a workbook is open or not; if you need to go as far as checking the shared/exclusive status, you'll have to add bits from VBAjedi's code)

Code:
Function wbOpen(strWBname As String) As Boolean
    On Error Resume Next
    Dim WB As Workbook
    Err.Clear
    Set WB = Workbooks(strWBname)
    If Err.Number <> 0 Then
        wbOpen = False
    Else
        wbOpen = True
    End If
    Err.Clear
End Function

NOTE:
You can't open two workbooks with the same name, but it is possible that the file is Workbooks() and the file below strWBname have the same name but are different files in different directories. If you want to make sure they are the exact same file, then add a parameter strWBpath and change the contents of the
Code:
Else
clause to:

Code:
if WB.path = strWBpath then
    wbOpen = True
end if

I didn't put this in because I personally prefer to not to enforce the path of the user, because if the user simply moves the document to another folder, it won't recognize it as being open even though it's the same file. Also, it means you have to know the full path of the file you want to check, which isn't always the case. But I added it to the end in case it suits your purpose. The path could also be used as an optional parameter and only checked when actually supplied when calling the function.

krinid
 
Skip,
I had done several online searches and the above method seemed to me (at the time) to be the only suggested way of checking if a workbook was open. Apologies for not being clearer (normally I am pretty specific!). I would still appreciate seeing what you came up with. It'll be useful for me as I'm still getting to grips with VBA. And I'm sure others who stumble upon this thread would appreciate it too.

VBA Jedi & krinid,
Thanks for quality answers - stars for you!

Clive [infinity]
Ex nihilo, nihil fit (Out of nothing, nothing comes)
 
In testing the above with 2 local open Excel sessions, the variant users comes back empty if the session NOT running the above code has the file in question open. I added the slight refinement below to the users test to handle that situation. The code above works anyway because of the Resume Next error handling.

If Not wkb Is Nothing Then
'returns array of user names, access times, and
'exclusive/shared mode indicator
users = wkb.UserStatus
If IsEmpty(users) Then
IsWorkbookOpen = True
'multiple users have file open
ElseIf UBound(users, 1) > 1 Then

IsWorkbookOpen = True
End If

Have a great day!


 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top