ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Checking if a workbook is open (https://www.excelbanter.com/excel-programming/449214-checking-if-workbook-open.html)

kardifflad

Checking if a workbook is open
 
Hi.
I have this bit of code that is meant to check if a certain workbook is open and if it is its meant to tell the user to try again later. Unortunately it doesn't. It just skips the msgbox and carries on regardless.
can anyone se the problem with the code please?

Function BookOpen(Bk As String) As Boolean

Dim T As Excel.Workbook
Err.clear
On Error Resume Next
Set T = Application.Workbooks(Bk)
BookOpen = Not T Is Nothing
Err.clear
On Error GoTo 0
End Function


Sub OpenAWorkbook()

Dim IsOpen As Boolean
Dim Bookname As String

Bookname = "\\Irf00743\lc ccg ctops bdap\Dissolutions\Holding folder\Todays Dissolution requests.xls"
IsOpen = BookOpen(Bookname)
If IsOpen Then
MsgBox "The Dissolution Tool is curently in use. Please try again in a few minutes"
Else

End If


End Sub

kardifflad

I should add that it start at OpenAWorkbook. (the code here is backwards sorry)

GS[_2_]

Checking if a workbook is open
 
Hi.
I have this bit of code that is meant to check if a certain workbook
is open and if it is its meant to tell the user to try again later.
Unortunately it doesn't. It just skips the msgbox and carries on
regardless.
can anyone se the problem with the code please?

Function BookOpen(Bk As String) As Boolean

Dim T As Excel.Workbook
Err.clear
On Error Resume Next
Set T = Application.Workbooks(Bk)
BookOpen = Not T Is Nothing
Err.clear
On Error GoTo 0
End Function


Sub OpenAWorkbook()

Dim IsOpen As Boolean
Dim Bookname As String

Bookname = "\\Irf00743\lc ccg ctops bdap\Dissolutions\Holding
folder\Todays Dissolution requests.xls"
IsOpen = BookOpen(Bookname)
If IsOpen Then
MsgBox "The Dissolution Tool is curently in use. Please try again in
a few minutes"
Else

End If


End Sub


This code will only work if the subject file is open on the machine
running the code. It can't determine if a file on a network share is in
use by another user. You'll need a 'Service' app to monitor this that
returns a specific response to a query that you can evaluate.
Unfortunately, this is beyond the scope of MS Office VBA.

You might be able to open the file and test it for 'Read Only'. Another
approach is to have the VBA project create/delete a txt file in the
location of the subject workbook to see if it exists. Your VBA project
can be revised to delete the file when the user closes the subject
workbook. Now if the file doesn't exist then your project can open it.

Something like...

Function bFileExists(Filename As String) As Boolean
' Checks if a file exists in the specified path
On Error Resume Next
bFileExists = (Dir$(Filename) < "")
End Function

Sub OpenAWorkbook()
Const sPath$ = "\\Irf00743\lc ccg ctops bdap\Dissolutions\Holding
folder\"
Const sFileToCheck$ = "FileIsOpen.txt"
Const sFileToOpen$ = "Todays Dissolution requests.xls"

If bFileExists(sPath & sFileToCheck) Then
MsgBox "The Dissolution Tool is curently in use." _
& vbLf & "Please try again in a few minutes"
Else
Workbooks.Open sPath & sFileToOpen
End If
End Sub

...and have your subject file handle the create/delete for its 'open
flag' txt file in its Workbook_Open and Workbook_BeforeClose events,
respectively...

In the subject file's ThisWorkbook module:

Option Explicit

Const sPath$ = _
"\\Irf00743\lc ccg ctops bdap\Dissolutions\Holding folder\"
Const sFileToCheck$ = "FileIsOpen.txt"


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Kill sPath & sFileToCheck
End Sub

Private Sub Workbook_Open()
Dim iNum%
iNum = FreeFile()
Open sPath & sFileToCheck For Output As #iNum
Close #iNum
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion



kardifflad

thanks you Garry.This is helpful to know.

I have done what you said in adding the code to the subject file (the file i want to write to), but it is not creating any txt file when opened.
i've added it as a module and in the sheet code but i guess it is not "firing up". Am i meant to set something to make it run when the workbook opens or should it already be doing that with the workbook_open code?

GS[_2_]

Checking if a workbook is open
 
thanks you Garry.This is helpful to know.

I have done what you said in adding the code to the subject file (the
file i want to write to), but it is not creating any txt file when
opened.
i've added it as a module and in the sheet code but i guess it is not
"firing up". Am i meant to set something to make it run when the
workbook opens or should it already be doing that with the
workbook_open code?


There are 2 different sets of code blocks. The first set goes in a
standard code module (where your current Sub OpenAWorkbook is located)
in your project.

The 2nd block goes (as instructed) in the ThisWorkbook code window of
your subject file. It needs to be revised as follows in case a user
opens the subject file by some other means than your project. (Serves
as a safety mechanism to prevent more than 1 instance is in use at the
same time)...

Option Explicit


Const sFileToCheck$ = "FileIsOpen.txt"
Dim mbCreator As Boolean


Private Sub Workbook_BeforeClose(Cancel As Boolean)
' Delete file ONLY if ThisWorkbook created it
If mbCreator Then _
Kill ThisWorkbook.Path & sFileToCheck
End Sub

Private Sub Workbook_Open()
mbCreator = Not bFileExists(ThisWorkbook.Path & sFileToCheck)
If Not mbCreator Then '//disallow multiple instances
ThisWorkbook.Close SaveChanges:=False
Else '//create the file and set delete flag
Dim iNum%
iNum = FreeFile()
Open ThisWorkbook.Path & sFileToCheck For Output As #iNum
Close #iNum: mbCreator = True
End If
End Sub

Private Function bFileExists(Filename As String) As Boolean
' Checks if a file exists in the specified path
On Error Resume Next
bFileExists = (Dir$(Filename) < "")
End Function

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion



GS[_2_]

Checking if a workbook is open
 
Oops.., major booboo...

Change this...

Const sFileToCheck$ = "FileIsOpen.txt"

To this...

Const sFileToCheck$ = "\FileIsOpen.txt"

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion



GS[_2_]

Checking if a workbook is open
 
Note that this still doesn't prevent users from opening the subject
file with macros disabled. In this case you might want to make sure its
path is a 'Trusted Location' for macro security so the enable macros
prompt doesn't display.

Also note that I tested this code and it works exactly as expected!
That means if FileToCheck.txt exists then the subject workbook closes.
Otherwise, it creates the file and deletes it on closing.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion



kardifflad

Thanks garry, this is excellent and has been a great help. I've learned a lot from this. cheers.

GS[_2_]

Checking if a workbook is open
 
Thanks garry, this is excellent and has been a great help. I've
learned a lot from this. cheers.


You're welcome. I appreciate the feedback...

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion




All times are GMT +1. The time now is 12:12 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com