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
Sub Primer1()
    If BookOpenClosed("Книга1.xlsx") Then
        MsgBox "Книга открыта"
    Else
        MsgBox "Книга закрыта"
    End If
End Sub

Do While Имя <> ""
If IsBookOpen(Папка & Имя) = False Then
With .Workbooks.Open _
(Filename:=Папка & Имя, UpdateLinks:=True)
'здесь Ваш макрос делает свое грязное дело
.Close SaveChanges:=True
End With
End If
Имя = Dir
Loop

'Макрос при открытии Книги открывает все файлы в Папке по очереди, обновляет связи, сохраняет и закрывает. Если файл уже открыт, то он пропускается.
Sub update()
With Application 'операции с приложением/отключаем для повышения скорости работы макроса
.ScreenUpdating = False 'обновление экрана
.DisplayAlerts = False 'вывод системных сообщений
Папка = "C:\Test\"
'------------ Excel-файлы в этой папке ------------------
Имя = Dir(Папка & "*.xlsx")
Do While Имя <> ""
If IsBookOpen(Папка & Имя) = False Then
With .Workbooks.Open _
(FileName:=Папка & Имя, UpdateLinks:=True)
'здесь Ваш макрос делает свое грязное дело
.Close SaveChanges:=True
End With
End If
Имя = Dir
Loop
.ScreenUpdating = True 'обновление экрана
.DisplayAlerts = True 'вывод системных сообщений
End With
ThisWorkbook.RefreshAll
End Sub



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 TsetOpenFiles()
    Dim i As Long
      
    For i = 1 To 15 'Цикл с третьей по седьмую ячейку столбца В
        
        Workbooks.Open Filename:=Cells(i, 3).Value
             With ActiveWorkbook
                Application.ScreenUpdating = False
                Application.Calculation = xlCalculationAutomatic
                Application.CalculateFull
                ThisWorkbook.RefreshAll
                ActiveWorkbook.Close SaveChanges:=True
             End With
    Next



End Sub

Option Explicit
Public fso As Object
'v2
Sub Обновить_связи()
    Dim openedBooks As Object
    Set openedBooks = GetOpenedBooks()
    
    Dim doneBooks As Object
    Set doneBooks = CreateObject("Scripting.Dictionary")
    
    Application.ScreenUpdating = False
    Dim Application_Calculation As XlCalculation: Application_Calculation = Application.Calculation: Application.Calculation = xlCalculationManual
    
    OpenLinkSources ActiveWorkbook, doneBooks
    Application.Calculate
    CloseJustOpenedBooks openedBooks
    
    Application.Calculation = Application_Calculation
    Application.ScreenUpdating = True
    
    MsgBox "Обновлены файлы:" & vbCrLf & vbCrLf & Join(doneBooks.Items(), vbCrLf), vbInformation, "Связи"
End Sub

Private Sub OpenLinkSources(wbInit As Workbook, doneBooks As Object)
    doneBooks(wbInit.FullName) = wbInit.Name
    Dim vLink As Variant, aLink As Variant, wbSource As Workbook
    aLink = wbInit.LinkSources(xlExcelLinks)
    If Not IsEmpty(aLink) Then
        For Each vLink In aLink
            If Not doneBooks.Exists(vLink) Then
                Set wbSource = GetWb(vLink)
                OpenLinkSources wbSource, doneBooks
            End If
        Next
    End If
End Sub

Private Function GetWb(ByVal sFull As String) As Workbook
    If fso Is Nothing Then Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FileExists(sFull) Then Exit Function
    Dim sName As String
    sName = fso.GetFileName(sFull)
    
    Dim wb As Workbook
    On Error Resume Next
    Set wb = Workbooks(sName)
    On Error GoTo 0
    If Not wb Is Nothing Then
        If LCase(wb.FullName) <> LCase(sFull) Then
            wb.Close False
            Set wb = Nothing
        End If
    End If
    If wb Is Nothing Then
        Set wb = Workbooks.Open(sFull, False, False)
    End If
    
    Set GetWb = wb
End Function

Private Function GetOpenedBooks() As Object
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim wb As Workbook
    For Each wb In Application.Workbooks
        dic(wb.FullName) = Empty
    Next
    
    Set GetOpenedBooks = dic
End Function

Private Sub CloseJustOpenedBooks(openedBooks As Object)
    Dim wb As Workbook
    For Each wb In Application.Workbooks
        If Not openedBooks.Exists(wb.FullName) Then
            wb.Close True
        End If
    Next
End Sub

Option Explicit
Public fso As Object
'v3
Sub Обновить_связи()
    Dim openedBooks As Object
    Set openedBooks = GetOpenedBooks()
    
    Dim doneBooks As Object
    Set doneBooks = CreateObject("Scripting.Dictionary")
    
    Application.ScreenUpdating = False
    Dim Application_Calculation As XlCalculation: Application_Calculation = Application.Calculation: Application.Calculation = xlCalculationManual
    
    OpenLinkSources ActiveWorkbook, doneBooks
    Application.Calculate
    CloseJustOpenedBooks openedBooks
    
    Application.Calculation = Application_Calculation
    Application.ScreenUpdating = True
    
    MsgBox "Обновлены файлы:" & vbCrLf & vbCrLf & Join(doneBooks.Items(), vbCrLf), vbInformation, "Связи"
End Sub

Private Sub OpenLinkSources(wbInit As Workbook, doneBooks As Object)
    doneBooks(wbInit.FullName) = wbInit.Name
    Dim vLink As Variant, aLink As Variant, wbSource As Workbook
    aLink = wbInit.LinkSources(xlExcelLinks)
    If Not IsEmpty(aLink) Then
        For Each vLink In aLink
            If Not doneBooks.Exists(vLink) Then
                Set wbSource = GetWb(vLink)
                OpenLinkSources wbSource, doneBooks
            End If
        Next
    End If
End Sub

Private Function GetWb(ByVal sFull As String) As Workbook
    Dim wb As Workbook
    On Error Resume Next
    Set wb = Workbooks(sFull)
    On Error GoTo 0
    If Not wb Is Nothing Then
        Set GetWb = wb
        Exit Function
    End If
    
    If fso Is Nothing Then Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FileExists(sFull) Then Exit Function
    Dim sName As String
    sName = fso.GetFileName(sFull)
    
    On Error Resume Next
    Set wb = Workbooks(sName)
    On Error GoTo 0
    If Not wb Is Nothing Then
        If LCase(wb.FullName) <> LCase(sFull) Then
            wb.Close False
            Set wb = Nothing
        End If
    End If
    If wb Is Nothing Then
        Set wb = Workbooks.Open(sFull, False, False)
    End If
    
    Set GetWb = wb
End Function

Private Function GetOpenedBooks() As Object
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim wb As Workbook
    For Each wb In Application.Workbooks
        dic(wb.FullName) = Empty
    Next
    
    Set GetOpenedBooks = dic
End Function

Private Sub CloseJustOpenedBooks(openedBooks As Object)
    Dim wb As Workbook
    For Each wb In Application.Workbooks
        If Not openedBooks.Exists(wb.FullName) Then
            wb.Close True
        End If
    Next
End Sub