Question

在以下威胁中，我使用了Siddharth Rout提供的代码。 Detect whether Excel workbook is already open

我的目标是检查某个已命名的工作簿是否打开，并根据结果执行某些操作。这就是结果。

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

下面的部分返回到该函数，并根据结果执行某些操作。

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

过去，该方法过去一直运行良好，但是从今天起，它突然出现了错误53。

在尝试解决问题时，我发现错误仅在命名工作簿不在桌面上时发生。奇怪的是，它过去没有这个问题。我专门进行了测试，因为该文件将不会始终位于桌面上。我尝试了两个备份，追溯了两个月，甚至现在显示了相同的错误。

在互联网上搜索此问题时，我发现了此主题， Check if excel workbook is open? 他们建议更改以下内容，（ErrNo = Err）转换为（Errno = Err.Number）（ff = FreeFile_（））转换为（ff = FreeFile）我一起和独立地做着。即使我没有真正看到错误和Freefile之间的关系。这根本没有改变错误。

虽然我很想知道为什么突然发生此错误，但我确实需要解决方案或替代方案。

我需要再次做的是， -检查命名工作簿是否打开。 -当打开时，带有“是”的Msgbox不应出现任何选项。 -在“否”上，应关闭命名的工作簿并继续执行我发布的内容以下的内容。 -启用，应弹出一个消息框并停止。

我们将不胜感激。

Answer 1

您需要先检查文件是否存在，然后再检查文件是否打开；

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

检测某些命名的工作簿是否打开。错误53

1 个答案: