is file in use??

Hi,

There are a number of ways to test whether a workbook is open. Here is one:

Sub Main()
Dim strWbkName As String


strWbkName = "YourWorkbookName"
'set your workbook name


If IsWorkbookOpen(strWbkName) = False Then
'call the function to test if it is open
    MsgBox "The workbook " & strWbkName & " is not open!"
    Exit Sub
End If
'do your stuff here


End Sub


Function IsWorkbookOpen(stName As String) As Boolean
'IsWorkbookOpen returns True if stName is a member of the Workbooks
'collection, otherwise it returns False.
'stName must be provided as a filename without path
Dim Wkb As Workbook


On Error Resume Next ' in case it isn't open
Set Wkb = Workbooks(stName)
If Not Wkb Is Nothing Then
    IsWorkbookOpen = True
End If 'Boolean function assumed to be False unless set to True


End Function

HTH

(Not sure about the username part - perhaps somebody else can add that).

Sorry, now that I re-read your original message I can see that you meant in the context of a network situation.

How about Microsoft's suggested approach:
http://support.microsoft.com/d…spx?scid=KB;en-us;q138621

Thanks Richie

I was not ware of that KB-article

Insomniac,

Below is a hotch botch of hobbled together code from various sources plus some of my own ingenuity.

You may also find J-Walks site of interest on this topic.

So far from my searching no one has been able to figure a work around for doing what you and I want. It's especially more difficult if not (dare I say) impossible to do this with a hidden worksheet / workbook or addin.

But luckily I don't understand impossible

Hope it helps.

1. J-Walks bits:

http://www.j-walk.com/ss/excel/tips/tip82.htm

2. My bits: (not as clean as J-Walk and others, but hey I'm fairly new to the VBA thing).

I'll break it down to steps for easy of explanation.

A. Open Two New Workbooks.

B. In the first Workbook under Module 1 place the following function. (I can't remember who's work this is but it's not mine.)

Function IsFileOpen(filename As String)
Dim filenum As Integer, errnum As Integer
' This function checks to see if a file is open or not. If the file is
' already open, it returns True. If the file is not open, it returns
' False. Otherwise, a run-time error will occur because there is
' some other problem accessing the file.
On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open filename For Input Lock Read As #filenum
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
IsFileOpen = False
' Error number for "Permission Denied."
' File is already opened by another user.
Case 70
IsFileOpen = True
' Another error occurred.
Case Else
Error errnum
End Select
End Function

C. In the first Workbook under Module 2 place the following code. (This is mostly my hobbled code.)

Sub CheckOpenUser()
On Error Resume Next
Application.ScreenUpdating = False
' Specify the Path to the file of your choice
If IsFileOpen("P:\Yadda\Yadda\Allocation Numbers AXXXXX.xls") Then
Application.ScreenUpdating = False
Application.Workbooks.Add
Application.ActiveWorkbook.Names.Add Name:="UserName", RefersToR1C1:="=Sheet1!R1C1"
'Specify the Path to the file of your choice and the Range Name UserID
Application.ActiveCell.FormulaR1C1 = "='P:\Yadda\Yadda\Allocation Numbers AXXXXX.xls'!UserID"
Calculate
'Fairly straight forward I'm telling it that the UserID = the UserName
UserID = Application.Range("UserName").Text
'A message to give the info
MsgBox "The Allocation Register is currently being used by: " & UserID & vbCr & vbCr & "Please try again later.", vbInformation
Application.ActiveWorkbook.Close savechanges:=False
Else
Workbooks.Open filename:="P:\Yadda\Yadda\Allocation Numbers AXXXXX.xls"
End If
End Sub

Because I'm running my code from an addin I don't have a visible Worksheet to capture the returned Name and feed through to VBA, so I simply make one with screenupdating turned off so that no one sees it appear and then when the message has been read I dump it.

D. In the Second Workbook ( the one you want to check if it is open and who has it open) place this code under "This Workbook"

Sub Workbook_Open()
'Spec up the user
Users = ActiveWorkbook.UserStatus
'Spec in the sheet and range for the UserID, My Sheet name = Allocation No. , Range name = UserID (don't forget to name the range !)
ActiveWorkbook.Sheets("Allocation No.").Activate
'UserID = the user name
Application.Range("UserID").Value = Users
Calculate
Application.StatusBar = "Updating Records.........Please wait."
'just something that needed to be done
ActiveWorkbook.Save
Application.StatusBar = ""
End Sub

Now what should happen is that when you run CheckOpenUser.

1. It will check to see if the file is open by someone else
2. If open it will bring back the username to the temporary workbook and from this fill in the message box.

Hope it works.

Regards

Tony