Как открыть макросом Excel второй экземпляр книги, если книга уже открыта?

Question

Имеется макрос, который получает значения из закрытой книги (формально он ее открывает, используя Workbooks.open(), отключает ивенты/алерты Application.ScreenUpdating = False, Application.DisplayAlerts = False, Application.EnableEvents = False, считывает то, что нужно, и книгу закрывает).

Книга находится на сервере, поэтому с ней могут работать другие пользователи. При выполнении моего макроса все экземпляры книги, открытые другими пользователями, закрываются. Я поставила проверку, чтобы книга не закрывалась, если была открыта до выполнения макроса, но это все равно не работает - книга закрывается, а затем открывается в Read-only режиме, изменения соответственно не сохраняются, если какой-то пользователь их вносил.

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

Answer 1

Sub CopyBook_()
    Dim sName As String
    Const sTempName As String = "D:\temptemp.xlsx" ' путь и имя временной копии книги'
    
    sName = "D:\123\test.xlsx" ' путь к книге'
    If Dir(sName, 1) = "" Then MsgBox "Книга не обнаружена", 16, "ОШИБКА": Exit Sub
    If Dir(sTempName, 1) <> "" Then Kill sTempName ' если старая копия есть, удаляем'
    
    With Application: .ScreenUpdating = False: .DisplayAlerts = False: End With

    With Workbooks.Open(Filename:=sName)
        .SaveAs Filename:=sTempName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

        With .Worksheets("sheet1")
             ' .......'
             ' .Cells(1,1).Value = ... работа с листом'
             ' .......'
        End With

        .Close
    End With
    
    Kill sTempName ' удаляем временную копию'
    With Application: .ScreenUpdating = True: .DisplayAlerts = True: End With
End Sub

Если путь к книге-источнику не изменяется программно, sName лучше записать константой.

Удаление существующей копии - это на случай, если по каким-либо причинам копия не удалена ранее. Проверку - открыта ли старая копия (маловероятно...) - не добавлял, для полного спокойствия можно дописать

Answer 2

А ларчик просто открывался:

Dim isOpen As Boolean
Dim wb As Workbook

Const originalPath As String = "C:\example.xlsm"
Const fileName As String = "example.xlsm"

'проверяем, открыта ли книга'
isOpen = IsBookOpen(originalPath)

'выключаем уведомления'
With Application: .ScreenUpdating = False: .DisplayAlerts = False: End With

'если закрыта, открываем, если открыта - обращаемся к открытой'
If Not isOpen Then Set wb = Workbooks.Open(originalPath)
If isOpen Then Set wb = Workbooks(fileName)

'строчка для того, чтобы посчитать и вытащить значения в текущую книгу'
ThisWorkbook.Activate

'начинаем работу со сторонней книгой'
On Error Resume Next
With wb.Worksheets("name")
'...'
End With
'закончили работу со сторонней книгой'

'если это мы ее открыли, закрываем'
If Not isOpen Then wb.Close savechanges:=False

'включаем уведомления обратно'
With Application: .ScreenUpdating = True: .DisplayAlerts = True: End With

БЛОГ НА HUSL

Как открыть макросом Excel второй экземпляр книги, если книга уже открыта?

Ответы (2 шт):