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:
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.
IsFileOpen = False
' Error number for "Permission Denied."
' File is already opened by another user.
IsFileOpen = True
' Another error occurred.
C. In the first Workbook under Module 2 place the following code. (This is mostly my hobbled code.)
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.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"
'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
Workbooks.Open filename:="P:\Yadda\Yadda\Allocation Numbers AXXXXX.xls"
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"
'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 !)
'UserID = the user name
Application.Range("UserID").Value = Users
Application.StatusBar = "Updating Records.........Please wait."
'just something that needed to be done
Application.StatusBar = ""
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.