Необходимо проверить открыта ли книга

Страница 1 из 1 1
Модератор форума: китин, _Boroda_, DrMini

Необходимо проверить открыта ли книга (Макросы/Sub)

maverick_77

Дата: Четверг, 30.07.2015, 17:01 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 39

Репутация: 0 ±

Замечаний: 20% ±

Excel 2010

Всем доброго дня!
Как можно решить такую задачу:
на сервере находится обще доступный файл ("База_Общая").
При работе со своим локальным файлом ("Отчёт") необходимо чтобы макрос проверил - открыта ли "База_Общая"? Если открыта кем-то другим - прекратить работу макроса. Если не открыт никем - открыть и перейти к этой самой "Базе_Общей". Если открыта у меня - просто перейти к нему.

Нашёл такое решение.
[vba]

Код

Sub Macro1
      Dim strFileName As String
      strFileName = "Q:\База данных\База_Общая.xlsm"
      If Not FileLocked(strFileName) Then
      Workbooks.Open strFileName
      Else: Exit Sub
      End If
End Sub

[/vba]
[vba]

Код

Function FileLocked(strFileName As String) As Boolean
     On Error Resume Next
     Open strFileName For Binary Access Read Write Lock Read Write As #1
     Close #1
     If Err.Number <> 0 Then

        MsgBox "Файл " & strFileName & " уже у кого-то открыт", vbInformation
        FileLocked = True
        Err.Clear
     End If
End Function

[/vba]

Но не работает как надо, если файл открыт у меня.
Что надо исправить?

если нельзя, но очень хочется, то можно!

Сообщение отредактировал maverick_77 - Четверг, 30.07.2015, 17:03

Ответить

Roman777

Дата: Четверг, 30.07.2015, 17:16 | Сообщение № 2

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

maverick_77,
попробуйте так:
[vba]

Код

Sub Macro1
      Dim strFileName As String
      strFileName = "Q:\База данных\База_Общая.xlsm"
      If IsBookOpen(strFileName) = false Then
      Workbooks.Open strFileName
      Else: Exit Sub
      End If
End Sub

[/vba]

[vba]

Код

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

[/vba]
Взято отсюдаль:
http://www.excel-vba.ru/chto-um....i-kniga

Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Четверг, 30.07.2015, 17:18

Ответить

RAN

Дата: Четверг, 30.07.2015, 17:24 | Сообщение № 3

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

[vba]

Код

Sub Macro1
     Dim strFileName As String
     strFileName = "Q:\База данных\База_Общая.xlsm"
For Each wbBook In Workbooks
         If wbBook.FullName = strFileName  Then exit sub
Next
     If Not FileLocked(strFileName) Then
     Workbooks.Open strFileName
     Else: Exit Sub
     End If
End Sub

[/vba]