F
flashpoint
What happens:
A file on a network drive - call it "one", which when opened creates
a file on the local drive - call it "two", & drops all holds on file
"one" in doing so. File "two", when printed, updates file "one" then
file "two" in that order leaving file "two" open on the local drive
until closed.
The premise:
File "one" is left available to all users with no restrictions at any
time and is updated along with "two" as changes are made. The reason
for doing it this way is because some users do not relinquish control
of file "one" for days at a time which is totally unacceptable.
The problem:
A means of eliminating multiple instances of file "two" being opened
on one computer whether it is in the same instance of excel or
separate instances of excel. Remember that file "one" creates an
instance of file "one" as it is opened.
The solution?:
'===================================
Function IsFileOpen(filename As String)
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 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.
Case 0
IsFileOpen = False
' Error number for "Permission Denied."
' File is already.
Case 70
IsFileOpen = True
' Another error occurred.
Case Else
Error errnum
End Select
End Function
Private Sub Workbook_Open()
'=====================================
Dim MyFile As String
' Returns "one.xls" if it exists. Checks is "one" exists
' skipping the remaining checks if it does not
MyFile = Dir("c:\one.xls")
If MyFile = "" Then
MsgBox "File does not exist."
GoTo ThatsAll
End If
'=====================================
' Test to see if the file is open.
If IsFileOpen("c:\one.xls") Then
' Test to see if the file is open in this instance of excel
Dim bk As Workbook
On Error Resume Next
Set bk = Workbooks("one.xls")
On Error GoTo 0
If Not bk Is Nothing Then
'MsgBox(prompt[, buttons] [, title] [, helpfile, context])
MsgBox "Please use the previously opened file. This
file will close after clicking OK"
ThisWorkbook.Close True ' close the file without saving
GoTo secondcheck
End If
' Display a message stating the file in use.
MsgBox "File is already open"
Application.Quit ' close Excel
'
secondcheck: '
'=====================================
Workbooks.Open "c:\two.xls"
ThatsAll:
End If
'===========================
End Sub
The questions:
I have tested this and as near as I am able to tell the code will do
the job.... But... will this work for all possibilities and is there
better ways of accomplishing the same thing?
Please help.
A file on a network drive - call it "one", which when opened creates
a file on the local drive - call it "two", & drops all holds on file
"one" in doing so. File "two", when printed, updates file "one" then
file "two" in that order leaving file "two" open on the local drive
until closed.
The premise:
File "one" is left available to all users with no restrictions at any
time and is updated along with "two" as changes are made. The reason
for doing it this way is because some users do not relinquish control
of file "one" for days at a time which is totally unacceptable.
The problem:
A means of eliminating multiple instances of file "two" being opened
on one computer whether it is in the same instance of excel or
separate instances of excel. Remember that file "one" creates an
instance of file "one" as it is opened.
The solution?:
'===================================
Function IsFileOpen(filename As String)
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 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.
Case 0
IsFileOpen = False
' Error number for "Permission Denied."
' File is already.
Case 70
IsFileOpen = True
' Another error occurred.
Case Else
Error errnum
End Select
End Function
Private Sub Workbook_Open()
'=====================================
Dim MyFile As String
' Returns "one.xls" if it exists. Checks is "one" exists
' skipping the remaining checks if it does not
MyFile = Dir("c:\one.xls")
If MyFile = "" Then
MsgBox "File does not exist."
GoTo ThatsAll
End If
'=====================================
' Test to see if the file is open.
If IsFileOpen("c:\one.xls") Then
' Test to see if the file is open in this instance of excel
Dim bk As Workbook
On Error Resume Next
Set bk = Workbooks("one.xls")
On Error GoTo 0
If Not bk Is Nothing Then
'MsgBox(prompt[, buttons] [, title] [, helpfile, context])
MsgBox "Please use the previously opened file. This
file will close after clicking OK"
ThisWorkbook.Close True ' close the file without saving
GoTo secondcheck
End If
' Display a message stating the file in use.
MsgBox "File is already open"
Application.Quit ' close Excel
'
secondcheck: '
'=====================================
Workbooks.Open "c:\two.xls"
ThatsAll:
End If
'===========================
End Sub
The questions:
I have tested this and as near as I am able to tell the code will do
the job.... But... will this work for all possibilities and is there
better ways of accomplishing the same thing?
Please help.