How do I open the second instance of a workbook with an Excel macro if the workbook is already open?

There is a macro that gets values from a closed book (formally, it opens it using Workbooks.open(), disables events/alerts Application.ScreenUpdating = False, Application.DisplayAlerts = False, Application.EnableEvents = False, reads what is needed, and closes the book).

The book is located on the server, so other users can work with it. When my macro is executed, all instances of the workbook opened by other users are closed. I set a check so that the book does not close if it was opened before the macro was executed, but it still does does not work - the book is closed and then opened in Read-only mode, changes are not saved accordingly, if some user made them.

The question is: is it possible to somehow force the macro to open the second instance of this book, read the necessary data and close it, so as not to touch the instances opened before?

 0
Author: Kromster, 2020-08-24

2 answers

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

If the path to the source book does not change programmatically, sName is better written as a constant.

Deleting an existing copy is just in case, for some reason, the copy was not deleted earlier. Check - whether the old copy is open (unlikely...) - did not add, for complete peace of mind, you can add

 1
Author: vikttur, 2020-08-24 12:38:20

And the casket just opened:

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
 1
Author: Angelika, 2020-08-25 11:06:51