Hi I'm using a code to verify if a workbook is open and if it is I message the user to close the workbook. This is for an MS ACCESS Form. My current code is as follows:
Option Explicit
Sub Sample()
Dim Ret
Dim strPath as string
strpath = "C:\myWork.xlsx"
Ret = IsWorkBookOpen(strpath)
If Ret = True Then
MsgBox "File is open"
Else
MsgBox "File is Closed"
End If
End Sub
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
I use it in different forms and the Directory changes depending on where the user wants it. It sometimes work but most of the time I get a Run Time Error. When I verify the Err variable it's alaway Err = 53 if its open or not. Sometimes Err = 70 or Err = 0 and the code runs smoothly but it is never the case.
Error #53 is File Not Found.
This site has code that does exactly what you're trying to do:
http://accessexperts.com/blog/2012/03/06/checking-if-files-are-locked/
The error you are getting means "file not found" (you can use Err.Description to get something more informative than "53"). Maybe there is a problem with the name, or the path, or some stray characters crept in... Or maybe it has to do with the way you generated the names in the first place. See http://www.excelforum.com/excel-programming-vba-macros/727403-runtime-error-53-file-not-found.html for a possible scenario and workaround. Without more information about the file name you passed to your routine when it failed it is hard to be more specific.
I was having the exact same problem. In my case, I was able to fix the issue when I realized I was sending the IsWorkbookOpen Function just the name of the file, but without the path. When I modified my initial code to send the file an argument in the form of a string that contained both the path and the filename, concatenated together, it worked.
Related
I was wondering if someone could help me with a PowerPoint VBA issue that I have encountered. I have a system of two PowerPoint presentations that I have linked dynamically and interactively using VBA, and which open using an external VBS script in the same folder which plays the PowerPoints in presentation mode and resizes and positions them on the screen. The VBS script links to this sub which automatically runs the other linked subs:
Sub Open_Presentation_VEdit()
Dim Ret
Dim Ret2
Dim PPT1 As Object
Set PPT1 = CreateObject("PowerPoint.Application")
Dim PPT2 As Object
Set PPT2 = CreateObject("PowerPoint.Application")
Dim filePath As String
filePath = ActivePresentation.Path
Ret = IsWorkBookOpen(filePath & "\Stand Up Title Page - With Macros.pptm")
Ret2 = IsWorkBookOpen(filePath & "\Stand Up Summary and Breakdowns - With Macros.pptm")
If Ret = True And Ret2 = False Then
Set PPT1 = Presentations("Stand Up Title Page - With Macros.pptm")
Set PPT2 = Presentations.Open(filePath & "\Stand Up Summary and Breakdowns - With Macros.pptm")
Call TaskbarAutohideOn
Call Resize_Presentations
Else: MsgBox "Close all stand-up wall slides"
End If
End Sub
The problem I am having is that a function that I have, IsWorkBookOpen, is creating problems for allowing multiple users to the system:
Function IsWorkBookOpen(fileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open fileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
I have this function written in because I was having problems with the opening sequence if someone pressed the script multiple times, lots of versions of the two PowerPoints tried to open which caused issues with the code and errors.
However, the system needs to be opened by multiple people at once, who are accessing this over a network. Is it possible to write a function that can tell if an individual user has the two presentations open? I.e. allow only one copy of each presentation to be open at one time by an individual user, but allow multiple users.
Thanks in advance for any help!
I am using Office 365 on a windows 10 PC.
I have some VBA code in Access to check whether a file is open or locked (the file is local to this PC).
On one computer this code runs for most files, but consistently crashes when it reaches a particular set of files. It is the same set of files each time if I manually step through the code to move on from the first file. I tried rebooting the PC to clear any locks, but the result is the same.
When I say crash, I mean that I loose control of Access and windows reports that it is no longer responding.
If I run the same code on a different PC, referring to the same files, it reports the file is locked, but does not crash.
The file is not locked, or not in the way I understand file locking. From the user interface, I can rename, move or delete the files at will.
I am fairly certain there is nothing wrong with the VBA code as written and am beginning to think there may be a corrupt DLL somewhere.
VBA references
My code crashes at the line Open my_source For Input Lock Read As #ff
Function copyormovemyfiles(my_source As String, my_dest As String, mycontrol As Integer) As Boolean
Dim fso As Scripting.FileSystemObject
Dim ff As Long, ErrNo As Long
''''''''''''''''
' mycontrol = 1 for a move
' mycontrol = 2 for a copy. It will not overwrite files
''''''''''''''''
On Error GoTo error_control
Set fso = New Scripting.FileSystemObject
If Not fso.FileExists(my_source) Then
Err.Raise 1000, , my_source & " does not exist!" & vbExclamation & "Source File Missing"
ElseIf Not fso.FileExists(my_dest) Then
fso.CopyFile my_source, my_dest, True
Else
Err.Raise 1000, my_dest & " already exists!" & vbExclamation
End If
Select Case mycontrol
Case 1
On Error Resume Next
ff = FreeFile()
Open my_source For Input Lock Read As #ff
Close ff
ErrNo = Err
'On Error GoTo 0
If ErrNo > 0 Then Stop
Err.Clear
'Select Case ErrNo
'Case 0: IsWorkBookOpen = False
'Case 70: IsWorkBookOpen = True
'Case Else: Error ErrNo
'End Select
On Error GoTo error_control
It's best to just do an action and then deal with the fail case instead of testing beforehand. The reason is that the state could change between your test and the action. Also, you are raising errors manually when you can just let your code raise it's errors organically.
So you say your copy won't overwrite but then you tell the copy command to overwrite. If we tell it not to overwrite then we no longer have to test if the source or destination exist, they both result in clear errors.
NOTE: Don't use underscore "_" in variable or function names because those are used for event definitions in the VBA event handler.
Function copyormovemyfiles(my_source As String, my_dest As String, mycontrol As Integer) As Boolean
''''''''''''''''
' mycontrol = 1 for a move
' mycontrol = 2 for a copy. It will not overwrite files
''''''''''''''''
On Error GoTo error_control
Dim fso As Scripting.FileSystemObject
fso.CopyFile my_source, my_dest, overwrite:=False
If mycontrol = 1 Then
SetAttr my_source, vbNormal
fso.DeleteFile my_source
End If
copyormovemyfiles = True
error_control:
If Err.Number <> 0 Then
' You can select case here and handle the error
copyormovemyfiles = False
End If
End Function
I have excel vba code that opens different files on makes use of them. An error can occur because there is no file where excel loos for it. I want to create a MsgBox on such errors with a message which specific file is absent.
Now I can only
On Error GoTo ErrorHandler
ErrorHandler:
MsgBox("File is absent")
But I can't specify which exactly file is absent. Is there a way to achieve it through error handler? Maybe through some additional variable?
EDIT: I open files through
Workbooks.Open Filename:=...
But I'm curious about what one should do if the case is
Dim fileTitle As String
filetitle=Dir()
as well.
Rather than hard-coding the file path via:
Workbooks.Open Filename:=...
Use a variable to represent the file path/name:
Dim fileName As String
fileName = "C:/path/to/my/file.xlsx"
Then, check to make sure it exists before you attempt to open it:
If FileIsAccessible(fileName) Then
' Do stuff
Else
MsgBox fileName & " doesn't exist or cannot be opened"
Exit Sub
End If
Use a custom function like
Function FileIsAccessible(path$) As Boolean
Dim FF As Long
On Error GoTo EarlyExit
FF = FreeFile
'Does file exist?
' Raises Error 53 if file not found
Open path For Input Access Read As FF
Close FF
'If file exist, is it accessible?
' Raises error 70 if file is locked/in-use
FF = FreeFile
Open path For Binary Access Write As FF
Close FF
EarlyExit:
FileIsAccessible = (Err.Number = 0)
End Function
You still have access to your variables in error handler, so you know within which file error happen:
Sub ...
Dim filename As String
On Error GoTo ErrorHandler
filename = Dir(...)
While filename>""
Set wb = Workbooks.Open(filename)
...
filename=Dir
Wend
Exit Sub
ErrorHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description & " File: " & filename
End Sub
Two ways to go about this. First, as you suggested, (which is also the easier of the two), you can make a variable that will carry the file name that you reassign after each file successfully loads. That name can then be passed into your message box in the event of a failure. If all you need to do is pass this name, this is the better solution.
The second option would be to create multiple error handlers. I would only recommend this if you need more customization with regard to how the error is handled, like wanting a different message to be displayed based on which type of file was missing. This option would make your code a good bit messier (as you would need to reassign the On Error GoTo ... statement multiple times, but its worth considering if you need a more complex solution.
Give this a try and tweak it as per your requirement. This will give you a starting point to deal with error handling....
Assuming you are trying to open a file abc.xlsx which is located at your Desktop and if this file isn't found on Desktop, the error handling will be triggered.
Don't forget to use Exit Sub before Error Handling label so that it is not executed if the file was found.
Dim wb As Workbook
Dim FilePath As String
FilePath = Environ("UserProfile") & "\Desktop\abc.xlsx"
On Error GoTo ErrorHandler
Set wb = Workbooks.Open(FilePath)
'Other stuff here if file was found and opened successfully
'
'
'
'
Exit Sub
ErrorHandler:
MsgBox Err.Number & vbNewLine & Err.Description, vbCritical, "File Not Found!"
I wanted to use shared excel workbooks on server which would be variously connected to each other.
I worked on it for many days to only find out it has many problems to cope with as shared workbooks do not support many features.
I wanted the macro to check on opening the file to find out whether the file is opened by someone else and if "yes", it would tell the person to come back later.
Unfortunately, I am now referencing to myself and this creates a loop.
I open the file, it checks itself it is opened already and then after the message it closes.
Could you please help me to evade the loop so it would suit the purpose?
I believe only the upper part of the code relates to my problem, so I do not post it in full:
Option Explicit
Private Sub Workbook_Open()
Dim Ret
Ret = IsWorkBookOpen(ThisWorkbook.FullName)
If Ret = True Then
MsgBox "Come back later."
ThisWorkbook.Close savechanges:=False
End If
End Sub
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
I don't think you need to use that function for your purpose.
You can actually check the status of the file using:
ThisWorkbook.ReadOnly
which returns a boolean; true if file is readonly.
Now, before opening the file you really cannot suppress the pop up asking if you want to open it as read only or not. But you can still try putting this code which will trigger once the user opened the file as read only.
Private Sub Workbook_Open()
If ThisWorkbook.ReadOnly Then
MsgBox "Comeback some other time. File in use"
ThisWorkbook.Close False
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.Quit
End Sub
The beauty of the IsWorkBookOpen approach is the speed compared to opening the workbook over a network compared to a ReadOnly test.
I would recommend you change your approach to load the check from a vbs, or a separate Excel file - as this is the best method.
The code below can be save in NotePad on your network drive as a vbs, say check.vbs. The code checks if the file is open, if not then it launches the file in a new instance of Excel. If it is, a message is provided.
vbs code
Dim objExcel
FileName = "C:\temp\file.xlsm"
If Not IsWorkBookOpen(FileName) Then
Set objExcel = CreateObject("Excel.Application")
Set ojbWb = objExcel.Workbooks.Open(FileName)
objExcel.Visible = True
Else
wscript.echo FileName & " already opened"
End If
Function IsWorkBookOpen(FileName)
Set oFSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set objFile = oFSO.OpenTextFile(filename, 8, False)
ErrNo = Err
ObjFile.Close
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
set objFSO = Nothing
End Function
If you want to run the check from the actual file then you will need to change to the ReadOnly test
code
Private Sub Workbook_Open()
If Me.ReadOnly Then MsgBox "file already opened", vbCritical
End Sub
I post this as I have seen this question unanswered on other forums, too.
I wanted to use many shared excel workbooks on server which would be variously connected to each other.
I wanted to use the so called shared workbook so everyone could access it and especially for the reason that it would track the changes within (users, time,...)
I wanted the macro to check on opening the file to find out whether the file is opened by someone else and if "yes", it would tell the person to come back later.
Suggested replies here could not help and I believe there is no chance to create a macro for path of the file itself so that IsWorkBookOpen(ThisWorkbook.FullName)
could be used the way I tried.
I decided to write macro that would track changes within the Workbook as if it was "shared". This way I was able to "unshare" it and use the ReadOnly approach discussed here.
I've made a macro to open two workbooks and do some stuff with them. This macro runs from a third workbook that calls any other two user selected workbooks for which, before they're opened, I don't know their name.
So! I know Excel 2010 doesn't have a built in function to check if a workbook is open so, I've been trying to compare the workbook against Nothing but it doesn't work and every workaround I find in different sites tend to use the name of the workbook.
Is there another way of doing this?
The idea is to run a macro with the two user defined workbooks and then, maybe, re-running it in the same workbooks but Excel warms me of discarding changes.
Maybe a workaround could be to tell excel when it prompts for reopening, not to reopen and handle that error to just use the same workbooks, for which at least, I know how part or the names will be. For example, one will have the text "cluster" in it, and the other the word "translation" so, maybe in a loop like the next one, I could find and use the workbook I need but just If I already checked if it's open. Or, does this way works to see if it's opened already?
For each wbk in Application.Workbooks
If wbk.Name Like "*cluster*" Then
WorkingWorkbook = wbk.Name
End If
next
My code is as follows:
Sub structure()
Application.ScreenUpdating = False
Dim translationWorkbook As Worksheet
Dim clusterWorkbook As Workbook
If Not clusterWorkbook Is Nothing Then
Set clusterWorkbook = Application.Workbooks.Open(ThisWorkbook.Sheets(1).Range("E5").Value2)
Else
Set clusterWorkbook = Application.Workbooks(parseFilePath(ThisWorkbook.Sheets(1).Range("E5")))
End If
Set translationWorkbook = Application.Workbooks.Open(ThisWorkbook.Sheets(1).Range("E6").Value2).Worksheets("String_IDs_Cluster") 'Translation table target for completing
End Sub
The parameter passed to Workbooks.Open is the one written in the sheet by my next function:
Private Sub MS_Select_Click()
Dim File As Variant
Dim Filt As String
Filt = "Excel 97-2003 File(*.xls), *.xls," & "Excel File(*.xlsx),*.xlsx," & "Excel Macro File (*.xlsm),*.xlsm"
File = Application.GetOpenFilename(FileFilter:=Filt, FilterIndex:=2, Title:="Select Menu Structure File")
If File = False Or File = "" Then
MsgBox "No File Selected"
Exit Sub
End If
ThisWorkbook.ActiveSheet.Range("E5").Value2 = File
End Sub
Same for translationWorkbook but in a different cell and also, I was trying to create a function to parse and use the filename in a full path(Then I discovered the command Dir lol) but when I pass the filename, without the xls extension to Application.Workbooks(file) it sends me a "subscript range error". Why could that be?
Basically my questions are:
How can I check for an open workbook and use it? Either by handling the
error for excel's prompt or by not trying to reopen the same file.
Why does trying to open a workbook with Application.Workbooks() with the return of my function fails? And here my question splits in two... First: with my function, wouldn't it work if I give a string as an argument? Or maybe, before passing it as an argument, I need to assign the result of my function to a variable?
Second: If I try to open a workbook like this Application.Workbooks("clusterworkbook") it sends me another "subscript error" but, before I used the File Dialog prompt, I made it this way and worked fine.
Any help will be appreciated.
EDIT
Function ParseFilePath added:
Function parseFilePath(fullpath As Range) As String
Dim found As Boolean
Dim contStart As Integer
Dim contEnd As Integer
contEnd = InStr(fullpath, ".") - 1
contStart = contEnd
found = False
Do While found = False
If fullpath.Characters(contStart, 1).Text = "\" Then
found = True
Else
contStart = contStart - 1
End If
Loop
parseFilePath = fullpath.Characters(contStart + 1, (contEnd - contStart)).Text
End Function
How can I check for an open workbook and use it? Either by handling the error for excel's prompt or by not trying to reopen the same file.
Have done some small modifications to your procedure structure. Similar to what you were trying testing for the workbook variable to be nothing, only that you have to first attempt to set the variable, the way you were doing it will always return empty as you did not try to set it before. I have also tested for the translation workbook, as it mightt be open as well.
I'm assuming the values in E5 and E6 contain the FullName of the workbook (i.e. path + filename) and that parseFilePath is a function to extract the filename from the FullName.
Sub structure()
Application.ScreenUpdating = False
Dim clusterWorkbook As Workbook
Dim translationWorkbook As Workbook
Dim translationWorksheet As Worksheet
With ThisWorkbook.Sheets(1)
On Error Resume Next
Set clusterWorkbook = Application.Workbooks(parseFilePath(.Range("E5").Value2))
On Error GoTo 0
If clusterWorkbook Is Nothing Then Set clusterWorkbook = Application.Workbooks.Open(.Range("E5").Value2)
'Set Translation table target for completing
On Error Resume Next
Set translationWorkbook = Application.Workbooks(parseFilePath(.Range("E6").Value2))
On Error GoTo 0
If translationWorkbook Is Nothing Then
Set translationWorksheet = Application.Workbooks.Open(.Range("E6").Value2).Sheets("String_IDs_Cluster")
Else
Set translationWorksheet = translationWorkbook.Sheets("String_IDs_Cluster")
End If
End With
End Sub
Why does trying to open a workbook with Application.Workbooks() with
the return of my function fails? And here my question splits in two...
First: with my function, wouldn't it work if I give a string as an
argument? Or maybe, before passing it as an argument, I need to assign
the result of my function to a variable?
Not sure why it did not work, change the prodedure as indicated.
I tested the procedure above using this function to extract the Filename from the Fullname and it worked:
Function parseFilePath(sFullName As String) As String
parseFilePath = Right(sFullName, Len(sFullName) - InStrRev(sFullName, "\"))
End Function
Second: If I try to open a workbook like this Application.Workbooks("clusterworkbook") it sends me another
"subscript error" but, before I used the File Dialog prompt, I made it
this way and worked fine.
Bear in mind that you did not used that line alone, it most probably has something like:
set Workbook = Application.Workbooks("clusterworkbook")
So the command was to set a variable, not to open the workbook, as such the only situation in which this works is that the workbook is already open so the variable gets set. The times when it failed was when the workbook was not open and you tried to set the variable, given you an error.
Suggest to visit these pages
Excel Objects, On Error Statement
I have been using the below code to identify if the excel workbook is open. If yes, then i activate it and do some stuff. If not, i open it and do some stuff.
sub test()
Dim Ret
Ret = IsWorkBookOpen("Your excel workbook full path")
If Ret = False Then
Workbooks.Open FileName:="Your excel workbook full path", UpdateLinks:=False
Else
Workbooks("Workbook name").Activate
End If
end sub
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function