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

Detect whether Excel workbook is already open

提问by user1222679

In VBA, I opened an MS Excel file named "myWork.XL" programmatically.

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

Now I would like a code that can tell me about its status - whether it is open or not. I.e. something like IsWorkBookOpened("myWork.XL)?

现在我想要一个可以告诉我它的状态的代码——它是否打开。即类似的东西IsWorkBookOpened("myWork.XL)？

回答by Siddharth Rout

Try this:

尝试这个：

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

回答by Dick Kusleika

For my applications, I generally want to work with a workbook rather than just determine if it's open. For that case, I prefer to skip the Boolean function and just return the workbook.

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

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

回答by Charles Williams

If its open it will be in the Workbooks collection:

如果它打开，它将在工作簿集合中：

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

回答by user2267971

I would go with this:

我会这样做：

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

as sFileName you have to provide direct path to the file for example:

作为 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

回答by Derek Johnson

What if you want to check without creating another Excel instance?

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

For example, I have a Word macro (which is run repeatedly) that needs to extract data from an Excel spreadsheet. If the spreadsheet is already open in an existing Excel instance, I would prefer not to create a new instance.

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

I found a great answer here that I built on: http://www.dbforums.com/microsoft-access/1022678-how-check-wether-excel-workbook-already-open-not-search-value.html

我在这里找到了一个很好的答案：http: //www.dbforums.com/microsoft-access/1022678-how-check-wether-excel-workbook-already-open-not-search-value.html

Thanks to MikeTheBike and kirankarnati

感谢 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

回答by Bulki

This one is a bit easier to understand:

这个比较容易理解：

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

回答by Kannan Suresh

Checkout this function

签出这个功能

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