Check for file open/closed status

  • Thread starter Thread starter Vacuum Sealed
  • Start date Start date
V

Vacuum Sealed

Hi all

I need help with the following please.

Check if myFile is open/closed, if it is open flash up a MsgBox
displaying ( if possible ) the user's identification.

There are some users in the office that have memory-holes between their
ears and leave files open after they have accessed and finished with
them. This specific file is backed up to at the end of each day and
upsets the whole process ( if left open ), when others forget to close it.

Something like:

If Workbook.myFile is open then

Msg("This person has the file open", vbOkOnly)
Cancel = True

Else

' Do my other stuff

I would like to have this run the check first so the user can cancel the
rest of the code if it is in use by someone else. He/She then can ask
the current user to close the file and continue.

Thx heaps in advance
Mick
 
hi Mick,

there is a possibility that you can create a log file.
the following code creates the text file "C:\xlslog.txt"
you need to copy this code on ThisWorkbook

Private Sub Workbook_open()
Ecritinfos ("ouvre")
TextStreamTest
End Sub

Sub Ecritinfos(data)
Open "c:\xlslog.txt" For Append As #1
Print #1, Format(Date, "dd/mm/yy ") & Format(Time, "hh:nn:ss") & " " & data & " " & ThisWorkbook.Name & " " & Application.UserName
Close #1
End Sub

Sub TextStreamTest()
Const ForReading = 1
Const TristateUseDefault = -2
Dim fs, f, ts, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile("c:\xlslog.txt")
Set ts = f.OpenAsTextStream(ForReading, TristateUseDefault)
s = Right(ts.ReadAll, 70)
MsgBox s
ts.Close
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Ecritinfos ("Ferme")
End Sub



you can check the result with the following function after saving the file, closing it and reopen it.

=testRead("c:\xlslog.txt")

Function testRead(fichier As String)
Const ForReading = 1
Const TristateUseDefault = -2
Dim fs, f, ts
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(fichier)
Set ts = f.OpenAsTextStream(ForReading, TristateUseDefault)
testRead = Right(ts.ReadAll, 70)
ts.Close
End Function
 
hi Mick,

there is a possibility that you can create a log file.
the following code creates the text file "C:\xlslog.txt"
you need to copy this code on ThisWorkbook

Private Sub Workbook_open()
Ecritinfos ("ouvre")
TextStreamTest
End Sub

Sub Ecritinfos(data)
Open "c:\xlslog.txt" For Append As #1
Print #1, Format(Date, "dd/mm/yy ") & Format(Time, "hh:nn:ss") & " " &
data & " " & ThisWorkbook.Name & " " & Application.UserName
Close #1
End Sub

Sub TextStreamTest()
Const ForReading = 1
Const TristateUseDefault = -2
Dim fs, f, ts, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile("c:\xlslog.txt")
Set ts = f.OpenAsTextStream(ForReading, TristateUseDefault)
s = Right(ts.ReadAll, 70)
MsgBox s
ts.Close
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Ecritinfos ("Ferme")
End Sub



you can check the result with the following function after saving the
file, closing it and reopen it.

=testRead("c:\xlslog.txt")

Function testRead(fichier As String)
Const ForReading = 1
Const TristateUseDefault = -2
Dim fs, f, ts
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(fichier)
Set ts = f.OpenAsTextStream(ForReading, TristateUseDefault)
testRead = Right(ts.ReadAll, 70)
ts.Close
End Function
Click to expand...
Hi Isabelle

Thank you for your assistance, how do I apply this please...


The file which usually gets left open is History.xls, and the file that
backs up to it is Schedule.xls

I figure I insert the log.txt section to the Workbook_Open() of
History.xls, but I am lost from this point. Do I call the function from
an If, Not, Then combination or do I just call it and then step into
myDoSomethingElse code.

Regards
Mick.
 
hi Mick,

for example you open the first file and then with this file, you want to know if the "xx" file is open

copy the following macros in the "xx" file

__on ThisWorkbook__________________________________________________________________________________

Private Sub Workbook_open()
Ecritinfos ("ouvre")
TextStreamTest
End Sub

Sub Ecritinfos(data)
Open "c:\xlslog.txt" For Append As #1
Print #1, Format(Date, "dd/mm/yy ") & Format(Time, "hh:nn:ss") & " " & data & " " & ThisWorkbook.Name & " " & Application.UserName
Close #1
End Sub

Sub TextStreamTest()
Const ForReading = 1
Const TristateUseDefault = -2

Dim fs, f, ts, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile("c:\xlslog.txt")
Set ts = f.OpenAsTextStream(ForReading, TristateUseDefault)
s = Right(ts.ReadAll, 70)
MsgBox s
ts.Close
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Ecritinfos ("Ferme")
End Sub


save the "xx" file and then close and reopen
__________________________________________________________________________________________________


copy the following Function in the first file (on Module1)

Function testRead(fichier As String)
Const ForReading = 1
Const TristateUseDefault = -2
Dim fs, f, ts
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(fichier)
Set ts = f.OpenAsTextStream(ForReading, TristateUseDefault)
testRead = Right(ts.ReadAll, 70)
ts.Close
End Function

then you can use the following formula in the first file

=testRead("c:\xlslog.txt")
 
Hi all

I need help with the following please.

Check if myFile is open/closed, if it is open flash up a MsgBox
displaying ( if possible ) the user's identification.

There are some users in the office that have memory-holes between their
ears and leave files open after they have accessed and finished with
them. This specific file is backed up to at the end of each day and
upsets the whole process ( if left open ), when others forget to close it..

Something like:

If Workbook.myFile is open then

Msg("This person has the file open", vbOkOnly)
Cancel = True

Else

' Do my other stuff

I would like to have this run the check first so the user can cancel the
rest of the code if it is in use by someone else. He/She then can ask
the current user to close the file and continue.

Thx heaps in advance
Mick
Click to expand...

Try this. It isn't as fancy, but it works.

On error resume next
dim WB as workbook
dim wbname as string

Set WB = Workbooks(wbname) 'Let wbname be the name of the open or
closed workbook

' If the workbook is not opened, the assignment in the previous line
' will result in an error. The error will tell you that the subscript
is out
' of range, the subscript being wbname. If there is an error, the
excel variable
' Err will ' be equal to a non zero value.

If Err <> 0 Then
Reply = MsgBox("The Workbook " & wbname & " is not Open.")
End If
 
There are some users in the office that have memory-holes between their
ears and leave files open after they have accessed and finished with
them. This specific file is backed up to at the end of each day and
upsets the whole process ( if left open ), when others forget to close it.
Click to expand...
<snip>

How about this idea... write a timer subroutine that periodically checks
the time of day... after the end of the shift it prompts the user to
close a message form that pops up every N minutes ("Do you want to
continue working on this file?" then they have to click a 'Yes'
button... if the button isn't clicked within some number of minutes the
subroutine saves the file and closes Excel?
 
Here's a reusable function I use often so I don't have to build code in
every procedure that needs to have a specific file open.

Function bBookIsOpen(wbkName As String) As Boolean
' Checks if a specified workbook is open.
' Arguments: wbkName The name of the workbook
' Returns: True if the workbook is open

Dim X As Workbook
On Error Resume Next
Set X = Workbooks(wbkName)
bBookIsOpen = (Err = 0)
End Function

Example usage...

If Not bBookIsOpen("MyFile.xls") Then
sTemp = "File is not open"
Else
sTemp = "File is open"
End If
MsgBox sTemp
 
Back
Top