Detect if certain named workbook is open. error 53 - ms-access

Question

I used the code provided by Siddharth Rout in the following threat.
Detect whether Excel workbook is already open
My goal was to check if a certain named workbook was open and depending on the result perform certain actions.
This was the result.
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
The following piece refers back to the function and depending on the result performs certain actions.
Dim xls As Object
Dim Answer As String
Dim Mynote As String
If IsWorkBookOpen(Environ("USERPROFILE") & "\Desktop\Report.xlsm") =
True Then
Mynote = "The Report is still open. Do you want to save the Report ?"
Answer = MsgBox(Mynote, vbQuestion + vbYesNo, "Warning Report open")
If Answer = vbYes Then
MsgBox "Please Save your Report under a new name and close it. then press update again"
Exit Sub
Else
Set xls = GetObject(Environ("USERPROFILE") & "\Desktop\Report.xlsm")
xls.Close True
End If
Else
End If
This used to work perfectly in the past but since today it suddenly gives me error 53.
While trying to resolve the issue I discovered the error only occurs when the named workbook is not on the desktop. Strangely enough it did not have this issue in the past. I specifically tested that because the file will not always be on the desktop.
I tried several backups tracking back 2 months and even those show the same error now.
While searching the internet for this issue i found this thread,
Check if excel workbook is open?
where they suggest to change the following pieces,
(ErrNo = Err) in to (Errno = Err.Number)
(ff = FreeFile_()) in to (ff = FreeFile)
I did both together and independitly. eventhough i dont really see the relation between the error and Freefile.
This did not change the error at all.
While I am currious to why this error suddenly occurs I really do need a solution or alternative.
what i need it tot do again is,
- Check if named workbook is open.
- when it is open a Msgbox with yes and no option should appear.
- On "No" it should close the named workbook and continue with whatever is below of what i posted.
- On yes it should pop a message box and stop.
Any help that can be provided will be highly appreciated.

Answer 1

You need to check if the file exists before checking if it is open;
Function FileExists(ByVal strFile As String, Optional bFindFolders As Boolean) As Boolean
'Purpose: Return True if the file exists, even if it is hidden.
'Arguments: strFile: File name to look for. Current directory searched if no path included.
' bFindFolders. If strFile is a folder, FileExists() returns False unless this argument is True.
'Note: Does not look inside subdirectories for the file.
'Author: Allen Browne. http://allenbrowne.com June, 2006.
Dim lngAttributes As Long
'Include read-only files, hidden files, system files.
lngAttributes = (vbReadOnly Or vbHidden Or vbSystem)
If bFindFolders Then
lngAttributes = (lngAttributes Or vbDirectory) 'Include folders as well.
Else
'Strip any trailing slash, so Dir does not look inside the folder.
Do While Right$(strFile, 1) = "\"
strFile = Left$(strFile, Len(strFile) - 1)
Loop
End If
'If Dir() returns something, the file exists.
On Error Resume Next
FileExists = (Len(Dir(strFile, lngAttributes)) > 0)
End Function