Обнаружить, что книга Excel уже открыта

Question

Я открыл файл MS Excel с именем «myWork.XL» через кодировку. Теперь я хочу код, который может рассказать мне о его статусе - независимо от того, открыт он или нет. Другими словами, если я открою тот же файл, он должен сказать мне, что файл уже открыт.

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 

Answer 2

Если его открыть его будет в коллекции Workbooks:

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 

Answer 3

Для моих приложений, я вообще хочу работать с книгой, а не просто определить, если это открытый. В этом случае я предпочитаю пропустить функцию Boolean и просто вернуть книгу.

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 

Answer 4

Это один немного легче понять:

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 

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 

Answer 6

Checkout эту функцию

Function to Check Whether a Workbook is Open

код из ссылки добавлен

'******************************************************************************************************************************************************************************** 
'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: "Nucleation.xlsx" or "C:\Users\Kannan.S\Desktop\Nucleation\Nucleation.xlsm" 
'Created by       : Kannan S 
'Email         : info@nucleation.in 
'Creation date      : 13-Nov-2013 
'Website        : www.nucleation.in 
'THIS CODE AND INFORMATION ARE PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT 
'LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. 
'Feel free to use the code as you wish but kindly keep this header section intact. 
'Copyright © 2013 Nucleation. All Rights Reserved. 
'******************************************************************************************************************************************************************************** 
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, "\") 
    Set WB = Application.Workbooks(OWBArray(UBound(OWBArray))) 
    WBName = OWBArray(UBound(OWBArray)) 
    WBPath = WB.Path & "\" & 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 

Answer 7

Я бы с этим:

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