检测Excel工作簿是否已经打开

Question

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

现在我想要一段代码，可以告诉我它的状态 - 是否已经打开。即类似于IsWorkBookOpened("myWork.XL) ？

- user1222679

Answer 1

试试这个：

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

- Siddharth Rout

---

+1 我已经使用这种方法一段时间来检查其他用户可以访问的网络驱动器上的文件。我认为这段代码最初是在微软网站上发布的。 - brettdj

个人而言，我觉得使用原始文件IO尝试在已经打开的Excel工作簿上进行文件读取会感到非常不舒服，因为在我看来有更好的替代方案，但也许它能够工作？ - Charles Williams

@Charles Williams：是的，它可能有些原始，但这仍然是一种没有缺点的好代码。至少在我所知道的范围内是这样的。 :) 也许你可以试试，也会喜欢它？ - Siddharth Rout

公允观点。但是在我的情况下，当我尝试类似的东西时，实际上打开托管在海外服务器上的大型模型所需的时间约为2-3分钟。这会让人感到“grrr”，因为它只是以只读方式打开，而上面的Sid函数则立即给出了响应。供参考，Bob Phillips在vbaexpress列出了类似的功能，更高级的版本需要等待书籍在Chip Pearson其他地方关闭。 - brettdj

@SiddharthRout 有一个缺点刚刚咬了我。我刚刚测试了上面的代码，当保存为“C:\myWork.xlsm”时，关闭，然后以只读方式打开并运行，将弹出MsgBox“文件已关闭”。这是不正确的，因为ThisWorkbook是打开并运行Sample()。似乎修复的方法是包括代码，也检查每个Application.Workbooks().name。 - Chuck The Nerd

Answer 2

在我的应用程序中，通常我希望使用工作簿而不仅仅是确定它是否已被打开。对于这种情况，我更喜欢跳过布尔函数，直接返回工作簿。

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

- Dick Kusleika

---

我同意这通常是所需的：如果您想检查书籍是否已经在另一个Excel实例中打开，您可以检查它是否以只读方式打开。 - Charles Williams

这会在 Workbooks(sFile) 上给我一个越界错误。 - motobói

代码中不能有 On Error Resume Next，或者在 VBE 的工具 - 选项中设置了“在所有错误上中断”。 - Dick Kusleika

这个版本对我来说更好，上面的版本似乎无法检测只读模式下打开的工作簿... - Lowpar

我曾经使用过这个，但最近在Excel 2017中遇到了很多“自动化错误”，当相关的工作簿在运行宏之前关闭时。解决方案是放弃On Error Resume Next（因为wbReturn不是Nothing，而是包含一个错误），并编写真正的错误处理程序。请参见：https://pastebin.com/u1LLgPa1 - André Chalella

如果工作簿在另一个Excel实例中打开，则此方法无效！ - feetwet

Answer 3

如果它是打开的，它将在工作簿集合中:

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

- Charles Williams

---

查尔斯，我已经想到这种方法了。这种方法的主要缺点是，如果工作簿在不同的Excel实例中打开，则始终会得到false值 :) 另一种替代方法是添加代码来循环浏览所有Excel实例，然后使用你的代码。 最终，我意识到我正在编写更多的代码，因此我采用了另一种方法。 Sid - Siddharth Rout

如果您想检查该书是否在另一个Excel实例中打开（可能是因为您无法保存或编辑它），为什么不在打开后检查其是否为只读（如果oBk.Readonly ...）？ - Charles Williams

Answer 4

我会选择这个方案：

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

- user2267971

Answer 5

如果您想在不创建另一个Excel实例的情况下进行检查怎么办？

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

我在这里找到了一个很好的答案，并在此基础上构建： http://www.dbforums.com/microsoft-access/1022678-how-check-wether-excel-workbook-already-open-not-search-value.html 感谢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

- Derek Johnson

Answer 6

这个比较容易理解：

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

- Bulki

---

Short and sweet :) - Linga

Answer 7

查看这个函数

'********************************************************************************************************************************************************************************
'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

- Kannan Suresh

---

这将捕获工作簿是否在本地机器上的当前实例中打开 - 它不会捕获工作簿是否在另一个本地实例或其他地方由另一个用户打开。 - brettdj

我认为 WB.Path & "\" & WBName 就是 WB.FullName。 - Winand

在退出函数之前，我还会添加 Set WB = Nothing。 - Mor Sagmon

现在只使用文件名进行操作... - Bhanu Pratap

我该如何在子程序中调用和使用这个函数？我的意思是，该函数的输入是字符串。 - FabioSpaghetti