检测Excel工作簿是否已打开

在VBA中，我以编程方式打开了一个名为“myWork.XL”的MS Excel文件

现在我想要一个代码，可以告诉我它的状态-无论它是开放的或没有。例如，类似于

IsWorkBookOpened（“myWork.XL）

？

尝试以下方法：

Option Explicit

Sub Sample()
    Dim Ret

    Ret = IsWorkBookOpen("C:\myWork.xlsx")

    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

---

如果其处于打开状态，则它将位于工作簿集合中：

Function BookOpen(strBookName As String) As Boolean
    Dim oBk As Workbook
    On Error Resume Next
    Set oBk = Workbooks(strBookName)
    On Error GoTo 0
    If oBk Is Nothing Then
        BookOpen = False
    Else
        BookOpen = True
    End If
End Function

Sub testbook()
    Dim strBookName As String
    strBookName = "myWork.xls"
    If BookOpen(strBookName) Then
        MsgBox strBookName & " is open", vbOKOnly + vbInformation
    Else
        MsgBox strBookName & " is NOT open", vbOKOnly + vbExclamation
    End If
End Sub

---

对于我的应用程序，我通常希望使用工作簿，而不仅仅是确定它是否打开。在这种情况下，我宁愿跳过布尔函数，只返回工作簿

Sub test()

    Dim wb As Workbook

    Set wb = GetWorkbook("C:\Users\dick\Dropbox\Excel\Hoops.xls")

    If Not wb Is Nothing Then
        Debug.Print wb.Name
    End If

End Sub

Public Function GetWorkbook(ByVal sFullName As String) As Workbook

    Dim sFile As String
    Dim wbReturn As Workbook

    sFile = Dir(sFullName)

    On Error Resume Next
        Set wbReturn = Workbooks(sFile)

        If wbReturn Is Nothing Then
            Set wbReturn = Workbooks.Open(sFullName)
        End If
    On Error GoTo 0

    Set GetWorkbook = wbReturn

End Function

---

这一点更容易理解：

Dim location As String
Dim wbk As Workbook

location = "c:\excel.xls"

Set wbk = Workbooks.Open(location)

'Check to see if file is already open
If wbk.ReadOnly Then
  ActiveWorkbook.Close
    MsgBox "Cannot update the excelsheet, someone currently using file. Please try again later."
    Exit Sub
End If

---

如果要在不创建另一个Excel实例的情况下进行检查，该怎么办

例如，我有一个Word宏（反复运行），需要从Excel电子表格中提取数据。如果电子表格已在现有Excel实例中打开，我不希望创建新实例

我在这里找到了一个很好的答案：

感谢MikeTheBike和kirankarnati

Function WorkbookOpen(strWorkBookName As String) As Boolean
    'Returns TRUE if the workbook is open
    Dim oXL As Excel.Application
    Dim oBk As Workbook

    On Error Resume Next
    Set oXL = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
        'Excel is NOT open, so the workbook cannot be open
        Err.Clear
        WorkbookOpen = False
    Else
        'Excel is open, check if workbook is open
        Set oBk = oXL.Workbooks(strWorkBookName)
        If oBk Is Nothing Then
            WorkbookOpen = False
        Else
            WorkbookOpen = True
            Set oBk = Nothing
        End If
    End If
    Set oXL = Nothing
End Function

Sub testWorkbookOpen()
    Dim strBookName As String
    strBookName = "myWork.xls"
    If WorkbookOpen(strBookName) Then
        msgbox strBookName & " is open", vbOKOnly + vbInformation
    Else
        msgbox strBookName & " is NOT open", vbOKOnly + vbExclamation
    End If
End Sub

函数WorkbookOpen（strWorkBookName作为字符串）作为布尔值
'如果工作簿处于打开状态，则返回TRUE
Dim-oXL作为Excel.Application
将oBk设置为工作簿
出错时继续下一步
Set oXL=GetObject（，“Excel.Application”）
如果错误号为0，则
'Excel未打开，因此无法打开工作簿
呃，明白了
WorkbookOpen=False
其他的
'Excel已打开，请检查工作簿是否已打开
Set oBk=oXL.工作簿（strWorkBookName）
如果oBk什么都不是，那么
WorkbookOpen=False
其他的
WorkbookOpen=True
设置oBk=Nothing
如果结束
如果结束
Set oXL=无
端函数
子测试工作簿打开（）
作为字符串的Dim STRBOOK名称
strBookName=“myWork.xls”
如果工作簿打开（strBookName），则
msgbox strBookName&“已打开”，vbOKOnly+vbInformation
其他的
msgbox strBookName&“未打开”，vbOKOnly+vb惊叹号
如果结束
端接头

签出此功能

'********************************************************************************************************************************************************************************
'Function Name                     : IsWorkBookOpen(ByVal OWB As String)
'Function Description             : Function to check whether specified workbook is open
'Data Parameters                  : OWB:- Specify name or path to the workbook. eg: "Book1.xlsx" or "C:\Users\Kannan.S\Desktop\Book1.xlsm"

'********************************************************************************************************************************************************************************
Function IsWorkBookOpen(ByVal OWB As String) As Boolean
    IsWorkBookOpen = False
    Dim WB As Excel.Workbook
    Dim WBName As String
    Dim WBPath As String
    Err.Clear
    On Error Resume Next
    OWBArray = Split(OWB, Application.PathSeparator)
    Set WB = Application.Workbooks(OWBArray(UBound(OWBArray)))
    WBName = OWBArray(UBound(OWBArray))
    WBPath = WB.Path & Application.PathSeparator & WBName
    If Not WB Is Nothing Then
        If UBound(OWBArray) > 0 Then
            If LCase(WBPath) = LCase(OWB) Then IsWorkBookOpen = True
        Else
            IsWorkBookOpen = True
        End If
    End If
    Err.Clear
End Function

我同意这一点：

Public Function FileInUse(sFileName) As Boolean
    On Error Resume Next
    Open sFileName For Binary Access Read Lock Read As #1
    Close #1
    FileInUse = IIf(Err.Number > 0, True, False)
    On Error GoTo 0
End Function

作为sFileName，您必须提供文件的直接路径，例如：

Sub Test_Sub()
    myFilePath = "C:\Users\UserName\Desktop\example.xlsx"
    If FileInUse(myFilePath) Then
        MsgBox "File is Opened"
    Else
        MsgBox "File is Closed"
    End If
End Sub

---

---

Charles，我已经想到了这种方法。这种方法的主要缺点是，如果工作簿是在不同的Excel实例中打开的，那么您将始终得到值为false:）另一种方法是添加代码以循环遍历所有Excel实例，然后使用您的代码。最终我意识到我正在编写更多的代码，因此我需要我们如果您想检查在另一个Excel实例中打开的书（可能是因为您无法保存或编辑它），为什么不在打开后检查它是否为只读（如果为oBk.Readonly…）+1我曾使用此方法检查其他用户可访问的NewWork驱动器上的文件。我认为该代码最初发布在msft网站上。就个人而言，当我知道有更好的替代方法时，使用原始文件IO尝试在打开的Excel工作簿上读取文件会让我感到非常不舒服：但也许它可以工作？@Charles Williams:是的，它可能很原始，但它仍然是一个不错的代码，没有缺点。至少我所知道的没有。：）试试看，也许你会喜欢它？我肯定它可以工作，但是你认为更简单更友好的Excel代码有什么缺点？（使用工作簿打开工作簿。打开并检查工作簿。只读）@Charles Williams公平点。虽然在我的案例中，当我尝试类似的方法时，实际打开一个托管在海外服务器上的大型模型的时间开销大约为2-3分钟。这会给出一个“grrr”“当它以只读方式打开时，而上面的Sid函数给出了即时响应。FWIW Bob Phillips在中列出了一个类似的函数，这是一个更高级的版本，等待从其他地方关闭该书。我同意这通常是需要的：如果您想检查该书是否已在另一个Excel实例中打开，您可以检查它是否已被只读打开

工作簿（sFile）上出现越界错误

在代码中不能有

错误恢复下一步

，或者在VBE中的“工具-选项”下设置了所有错误。此版本对我更适用，上面的版本似乎无法检测以只读方式打开的工作簿…我以前使用过此，但最近我在Excel 2017中遇到了很多自动化错误，因为在运行宏之前，相关工作簿已关闭。解决方案是放弃下一步错误恢复时的

（因为
wbreurn
不是
Nothing
，而是包含错误）并编写真正的错误处理。请参阅：这将捕获工作簿是否在本地计算机上的当前实例中打开-它不会捕获工作簿是在其他本地实例中打开的，还是由其他用户在其他位置打开的。我认为
WB.Path&“\”&WBName
是
WB.FullName
我还想在退出函数之前添加Set WB=Nothing现在只使用文件名…如何在子函数中调用和使用此函数？我的意思是这个函数的输入是StringShort和sweet:）