Excel vba проверка файла на открытие

Открыта или закрыта книга Excel? Проверяем с помощью кода VBA по краткому или полному имени файла, используя объектную переменную, цикл или оператор Open.

Проверка по краткому имени

Способ проверки по краткому имени, открыта ли рабочая книга, позволяет определить состояние проверяемой книги в том же экземпляре приложения Excel, в котором открыта книга с проверяющим кодом.

Использование объектной переменной

Вариант пользовательской функция VBA Excel, предназначенной для проверки, открыта или закрыта рабочая книга, путем определения результата присвоения ссылки на нее объектной переменной. Присвоение состоялось (BookOpenClosed = True) – книга открыта, произошла ошибка и присвоение не состоялось (BookOpenClosed = False) – книга закрыта.

Function BookOpenClosed(wbName As String) As Boolean

    Dim myBook As Workbook

    On Error Resume Next

        Set myBook = Workbooks(wbName)

    BookOpenClosed = Not myBook Is Nothing

End Function

Аргумент функции:

  • wbName – краткое имя проверяемой рабочей книги.

Перебор открытых книг циклом

Этот вариант функции BookOpenClosed перебирает с помощью цикла все открытые книги Excel и проверяет их краткие имена на совпадение с кратким именем проверяемой книги. Совпадение найдено (BookOpenClosed = True) – книга открыта, совпадение не найдено (BookOpenClosed = False) – книга закрыта.

Function BookOpenClosed(wbName As String) As Boolean

    Dim myBook As Workbook

    For Each myBook In Workbooks

        If myBook.Name = wbName Then

            BookOpenClosed = True

            Exit For

        End If

    Next

End Function

В коллекцию Workbooks входят и скрытые книги, в том числе Личная книга макросов, и книга с функцией.

Проверка по полному имени

Проверка по полному имени с помощью оператора Open позволяет узнать, открыта ли рабочая книга каким-либо другим процессом: текущим экземпляром Excel, в котором открыта книга с проверяющим кодом, другим экземпляром Excel или сторонним приложением.

Function BookOpenClosed(wbFullName As String) As Boolean

    Dim ff As Integer

    ff = FreeFile

        On Error Resume Next

        Open wbFullName For Random Access Read Write Lock Read Write As #ff

        Close #ff

    BookOpenClosed = (Err.Number <> 0)

End Function

Аргумент функции:

  • wbFullName – полное имя проверяемой рабочей книги.

Эта функция открывает с помощью оператора Open файл проверяемой книги с разрешением чтения и записи (параметр access) и запретом чтения и записи, если этот файл уже открыт другим процессом (параметр lock).

Если файл уже открыт другим процессом, а указанный тип доступа (параметр access) не разрешен (параметр lock), операция открытия завершится с ошибкой, а выражение (Err.Number <> 0) возвратит значение True.

Примеры проверки состояния книги

По краткому имени

Sub Primer1()

    If BookOpenClosed(«Книга1.xlsx») Then

        MsgBox «Книга открыта»

    Else

        MsgBox «Книга закрыта»

    End If

End Sub

По полному имени

Sub Primer2()

    If BookOpenClosed(«C:Папка1Папка2Папка3Книга1.xlsx») Then

        MsgBox «Книга открыта»

    Else

        MsgBox «Книга закрыта»

    End If

End Sub
Источник

Хитрости »

4 Май 2011              93379 просмотров

Как проверить открыта ли книга?

Собственно суть темы отражена в названии. Как при выполнении кода из VBA узнать перед обращением к книге открыта она или нет? Ведь если книга закрыта, то обращение к ней вызовет ошибку, а если открывать без проверки — то это может повлечь за собой утерю данных, если предварительно эта книга не была сохранена. Ни один ни второй вариант, естественно, не устраивают. Я покажу два способа проверки через функции. Если функция вернет True — книга открыта, если False — закрыта. Для проверки функций используем проверочную процедуру Check_Open_Book:

Sub Check_Open_Book()
    If IsBookOpen("Книга1.xls") Then
        MsgBox "Книга открыта", vbInformation, "Сообщение"
    Else
        MsgBox "Книга закрыта", vbInformation, "Сообщение"
        'открываем книгу
        Workbooks.Open "C:Книга1.xls"
    End If
End Sub

Данная процедура вызывает функцию IsBookOpen, передавая ей в качестве параметра имя книги, «открытость» которой мы хотим проверить. Я приведу несколько вариантов самой функции IsBookOpen. Во всех вариантах действует один и тот же принцип: код любого из вариантов функции IsBookOpen необходимо скопировать и вставить в стандартный модуль. Модуль должен быть внутри той книги, в кодах которой планируется проверять открыта ли книга. Только тогда IsBookOpen будет доступна для вызова из любого кода этой же книги.
Если вдруг в момент выполнения на строке If IsBookOpen(«Книга1.xls») Then появится ошибка «Sub or function not defined» — значит функция IsBookOpen либо не была скопирована в стандартный модуль, либо она вообще не в стандартном модуле, а в модуле листа, формы или книги.

Вариант 1:

Function IsBookOpen(wbName As String) As Boolean
    Dim wbBook As Workbook
    For Each wbBook In Workbooks
        If wbBook.Name <> ThisWorkbook.Name Then
            If Windows(wbBook.Name).Visible Then
                If wbBook.Name = wbName Then IsBookOpen = True: Exit For
            End If
        End If
    Next wbBook
End Function

Функция просматривает все открытые книги и если находит среди них книгу с указанным именем, то функция возвращает True. Есть небольшая особенность — функция исключает скрытые книги(это либо надстройки, либо PERSONAL.XLS). Так же из просмотра исключена та книга, в которой расположен сам код. Если Вам нужно проверить наличие книги независимо от её видимости, то необходимо просто заменить блок

    If Windows(wbBook.Name).Visible Then
        If wbBook.Name = wbName Then IsBookOpen = True: Exit For
    End If

на одну строку(просто убрать лишнее условие проверки)

    If wbBook.Name = wbName Then IsBookOpen = True: Exit For

Либо можно использовать

Вариант 2:

Function IsBookOpen(wbName As String) As Boolean
    Dim wbBook As Workbook: On Error Resume Next
    Set wbBook = Workbooks(wbName)
    IsBookOpen = Not wbBook Is Nothing
End Function

Данный способ обращается к любой открытой книге, даже если она скрыта как PERSONAL.XLS или надстройка. Однако у данной функции есть недостаток — используется оператор On Error и если в настройках VBA(Tools —Options -вкладка General) установлено Break on All Errors — то этот код не сработает, если книга не открыта — получим ошибку. В то время как Вариант1 с циклом по всем открытым книгам сработает без ошибок.

Вариант 3:

По просьбам читателей решил добавить код, который проверяет открыта ли книга независимо от её месторасположения и используемого приложения Excel. Книга может быть открыта другим пользователем (если книга на сервере), в другом экземпляре Excel или в этом же экземпляре Excel.

Function IsBookOpen(wbFullName As String) As Boolean
    Dim iFF As Integer, retval As Boolean
    iFF = FreeFile
    On Error Resume Next
    Open wbFullName For Random Access Read Write Lock Read Write As #iFF
    retval = (Err.Number <> 0)
    Close #iFF
    IsBookOpen = retval
End Function

Функция несколько отличается от приведенных выше — передается в неё не только имя книги, а полный путь к книге, включая имя и расширение:

Sub Test()
    MsgBox "Файл 'Книга1'" & IIf(IsBookOpen("C:Книга1.xls"), " уже открыт", " не занят")
End Sub

Или более близкий к жизненной ситуации вариант: надо открыть книгу, внести в книгу изменения, сохранить и закрыть. Если книга кем-то уже открыта — получим ошибку на этапе сохранения или запрос на этапе открытия. Поэтому сначала проверяем доступность книги и если она доступна — вносим изменения и сохраняем.

Sub Test()
    Dim sWBFullName As String
    Dim wb As Workbook
    'полный путь к проверяемой книге
    sWBFullName = "C:DocumentsКнига1.xls"
    'если книга кем-то открыта - пропускаем обработку этой книги
    'книга закрыта - вносим изменения, сохраняем, закрываем
    If IsBookOpen(sWBFullName) = False Then
        Set wb = Application.Workbooks.Open(sWBFullName)
        'изменяем значение ячейки "A1" на первом листе книги
        wb.Sheets(1).Range("A1").Value = "www.excel-vba.ru"
        ws.Close True
    End If
End Sub

При использовании функции IsBookOpen так же надо учитывать, что она может посчитать книгу открытой не только если она реально кем-то открыта, а если к ней просто нет доступа(например, заблокирован доступ со стороны администратора и т.п.).

Также см.:
Как получить данные из закрытой книги?
Как узнать существует ли лист в книге?
Как узнать существует ли модуль в книге

Статья помогла? Поделись ссылкой с друзьями!

  Плейлист   Видеоуроки

Поиск по меткам



Access
apple watch
Multex
Power Query и Power BI
VBA управление кодами
Бесплатные надстройки
Дата и время
Записки
ИП
Надстройки
Печать
Политика Конфиденциальности
Почта
Программы
Работа с приложениями
Разработка приложений
Росстат
Тренинги и вебинары
Финансовые
Форматирование
Функции Excel
акции MulTEx
ссылки
статистика

Источник

Option Compare Text ‘Если Вы не понимаете, зачем используется эта инструкция, то оставьте её в покое    

  Private Function WorkbookIsOpen(iName$) As Boolean    
‘***********************************************’    
‘   Дата создания 01/01/2005    
‘   Автор Климов Павел Юрьевич    
‘  

http://www.msoffice.nm.ru    

‘***********************************************’    
   Dim iBook As Workbook    
   For Each iBook In Workbooks    
       If iBook.Name = iName$ Then    
          WorkbookIsOpen = True    
          Exit Function    
       End If    
   Next    
   WorkbookIsOpen = False    
End Function  

  Private Function WorkbookIsOpen(iName$) As Boolean    
‘***********************************************’    
‘   Дата создания 01/01/2005    
‘   Автор Климов Павел Юрьевич    
‘  

http://www.msoffice.nm.ru    

‘***********************************************’    
   Dim iBook As Workbook    
   For Each iBook In Workbooks    
       If StrComp(iBook.Name, iName$, vbTextCompare) = 0 Then    
          WorkbookIsOpen = True    
          Exit Function    
       End If    
   Next    
   WorkbookIsOpen = False    
End Function  
Вариант II.    
Private Function WorkbookIsOpen(iName$) As Boolean    
‘***********************************************’    
‘   Дата создания 01/01/2005    
‘   Автор Климов Павел Юрьевич    
‘  

http://www.msoffice.nm.ru    

‘***********************************************’    
   On Error Resume Next    
   WorkbookIsOpen = IsObject(Workbooks(iName$))    
End Function  

  Private Function WorkbookIsOpen(iName$) As Boolean    
   On Error Resume Next    
   WorkbookIsOpen = (TypeOf Workbooks(iName$) Is Workbook)    
End Function  

  Private Function WorkbookIsOpen(iName$) As Boolean    
   On Error Resume Next    
   WorkbookIsOpen = (TypeName(Workbooks(iName$)) = «Workbook»)    
End Function  

  Private Function WorkbookIsOpen(iName$) As Boolean    
   On Error Resume Next    
   WorkbookIsOpen = (VarType(Workbooks(iName$)) = vbObject)    
End Function  

  Private Function WorkbookIsOpen(iName$) As Boolean    
   On Error Resume Next    
   WorkbookIsOpen = Len(Workbooks(iName$).Name) > 0    
End Function  

  Private Function WorkbookIsOpen(iName$) As Boolean    
   On Error Resume Next    
   WorkbookIsOpen = Workbooks(iName$).Index > 0    
End Function  
Пример вызова любой из вышеопубликованных авторских функций :    
Private Sub Test()    
   MsgBox WorkbookIsOpen(«Имя_Книги.xls»)    
End Sub

Источник

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

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) ?

Andrei Konstantinov's user avatar

asked Feb 21, 2012 at 6:19

user1222679's user avatar

0

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

Tim Cooper's user avatar

Tim Cooper

156k38 gold badges330 silver badges278 bronze badges

answered Feb 21, 2012 at 7:48

Siddharth Rout's user avatar

Siddharth RoutSiddharth Rout

146k17 gold badges206 silver badges250 bronze badges

12

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:UsersdickDropboxExcelHoops.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

answered Feb 21, 2012 at 17:18

Dick Kusleika's user avatar

Dick KusleikaDick Kusleika

32.5k4 gold badges51 silver badges73 bronze badges

6

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

answered Feb 21, 2012 at 8:44

Charles Williams's user avatar

Charles WilliamsCharles Williams

23.1k5 gold badges37 silver badges38 bronze badges

2

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:

Sub Test_Sub()
    myFilePath = "C:UsersUserNameDesktopexample.xlsx"
    If FileInUse(myFilePath) Then
        MsgBox "File is Opened"
    Else
        MsgBox "File is Closed"
    End If
End Sub

answered Mar 10, 2014 at 19:39

user2267971's user avatar

user2267971user2267971

3631 gold badge4 silver badges12 bronze badges

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

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.

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

Thanks to MikeTheBike and 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

answered Aug 9, 2013 at 7:19

Derek Johnson's user avatar

Derek JohnsonDerek Johnson

9271 gold badge11 silver badges15 bronze badges

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

answered Jul 9, 2013 at 14:26

Bulki's user avatar

BulkiBulki

7341 gold badge10 silver badges30 bronze badges

1

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:UsersKannan.SDesktopBook1.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

answered Nov 14, 2013 at 16:33

Kannan Suresh's user avatar

Kannan SureshKannan Suresh

4,5933 gold badges34 silver badges59 bronze badges

5

Источник
  • Remove From My Forums

  • Question

  • I wish to open a MS Word document by clicking on a button in an excel worksheet, but I need to check first to see if the document is already open.  The following code works correctly if the document is NOT open, but I need a way to deal with the «already
    open» situation. Currently the «Already Open» dialogue box appears, and when I click Cancel, the Word background is displayed with no document Showing.  Ideally the code would simply bring the requested already open document to the front, but an alternative
    would be to generate a message box telling me it was already open.

    Sub HelpAndInfo()

    ‘Open Help and Information Document
    Dim Wd As Object
    Dim HelpDoc As Object

        On Error GoTo Unset

        
        Set Wd = CreateObject(«Word.Application»)

        ‘If the doc is already open the next line pulls up the «Already Open» dialogue box .

        Set HelpDoc = Wd.Documents.Open(«C:UsersNAMEDocumentsComputerVBASpdSheetNotes.doc»)
        Wd.Visible = True

        
        On Error GoTo 0

    Unset:
        Set Wd = Nothing
        Set HelpDoc = Nothing

    End Sub

    Any help gratefully received.

Answers

  • Try this version:

    Sub HelpAndInfo()
    'Open Help and Information Document
    Const strpath = "C:UsersNAMEDocumentsComputerVBASpdSheetNotes.doc"
    Dim Wd As Object
    Dim HelpDoc As Object
    Dim f As Boolean
    On Error Resume Next
    Set HelpDoc = GetObject(strpath)
    If HelpDoc Is Nothing Then
        Set Wd = GetObject(, "Word.Application")
        If Wd Is Nothing Then
            Set Wd = CreateObject("Word.Application")
            If Wd Is Nothing Then
                MsgBox "Failed to start Word!", vbCritical
                Exit Sub
            End If
            f = True
        End If
        Set HelpDoc = Wd.Documents.Open(strpath)
        If HelpDoc Is Nothing Then
            MsgBox "Failed to open help document!", vbCritical
            If f Then
                Wd.Quit
            End If
            Exit Sub
        End If
        Wd.Visible = True
    Else
        With HelpDoc.Parent
            .Visible = True
            .Activate
        End With
    End If
End Sub

    Regards, Hans Vogelaar

    • Marked as answer by

      Friday, December 28, 2012 6:30 PM

Источник

Понравилась статья? Поделить с друзьями:
  • Excel vba проверка строки на пустоту
  • Excel vba проверка содержимого ячейки
  • Excel vba проверка пустого значения
  • Excel vba проверка орфографии
  • Excel vba проверка на ошибки