Проверка файл открыт или нет excel vba

Хитрости »

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

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

Собственно суть темы отражена в названии. Как при выполнении кода из 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
ссылки
статистика

VBA tries to evaluate all the parts before it evaluates the conditional statement. So if I have a variable myvar = "xyz" and try to run the following lines…

If IsNumeric(myvar) And Round(myvar, 1) = 3 Then
    'you will get an error before the IF is evaluated
End If

it will not work. VBA will evaluate IsNumeric(myvar) fine, then try to evaluate Round(myvar, 1) = 3 and get an error before it checks the entire conditional. So VBA will let you know about the error before it performs the AND operator. If VBA had short circuit evaluation, it would work fine since the first part would evaluate to false.

But the following will work

If IsNumeric(myvar) Then
    If Round(myvar, 1) = 3 Then
        'second IF statement is not touched since first IF statement evaluates to false
    End If
End If

This works because IsNumeric(myvar) evaluates to false and therefore skips the nested statement.

So the error it throws on the Workbooks(filename) will just give the error unless you tell it to resume next. So the method I use is

    On Error Resume Next
    Set wb = Workbooks(file)
    If wb Is Nothing Then
        Set wb = Application.Workbooks.Open(dir & "" & file, ReadOnly:=True)
    End If
    On Error GoTo 0

Edited to give more detail and correctly capture that the second example will not be evaluated as well as provide a useful solution for the question at hand.

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