Err.Clear
Application.DisplayAlerts = False
On Error Resume Next
With Workbooks("forum.xlsm").Connections("my_query").OLEDBConnection
    .BackgroundQuery = False  'or true, up to you
    .Refresh
End With
If Err.Number <> 0 Then GoTo nextx
Debug.Print "обновлено"
nextx:

Sub test()
Application.ScreenUpdating = False
If [a1] = "" Or [c1] = "" Then
    MsgBox "Cначала укажите путь в ячейку а1 и название книги в ячейку с1"
    Exit Sub
End If

my_cheking = Array("\", "/", ":", "*", "?", "<", ">", "|")

For i = 1 To UBound(my_cheking)
    If InStr([a1] & [c1], my_cheking(i)) <> 0 Then
        MsgBox "Сначала удалите символы \/:*?<>| в ячейках а1, с1"
        Exit Sub
    End If
Next i

path_to_save = "D:\Ортодонтия\" & [a1]
Debug.Print path_to_save
name_to_save = [c1]
Debug.Print name_to_save
On Error GoTo er
If Dir(path_to_save, vbDirectory) = "" Then MkDir (path_to_save)
        ActiveSheet.Copy
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=path_to_save & "\" & name_to_save, FileFormat:=51
        Application.DisplayAlerts = False
        Workbooks(name_to_save & ".xlsx").Close True
Application.ScreenUpdating = True
MsgBox "Этот лист успешно сохранен в отдельную книгу!"
Exit Sub
er: MsgBox "Проверьте наличие основных подкаталогов в файловой системе!"
End Sub

Sub Макрос1()
Application.ScreenUpdating = False
t = Timer
'диапазон где искать и что найти
a = Workbooks("пример11.xlsm").Worksheets("1").Range(Workbooks("пример11.xlsm").Worksheets("1").Range("a4"), Workbooks("пример11.xlsm").Worksheets("1").Range("a" & Rows.Count).End(xlUp)).Resize(, 4).Value
'диапазон, что искать(диапазон условий)
my_array = Workbooks("пример11.xlsm").Worksheets("2").Range(Workbooks("пример11.xlsm").Worksheets("2").Range("a1"), Workbooks("пример11.xlsm").Worksheets("2").Range("a" & Rows.Count).End(xlUp)).Resize(, 2).Value


For j = 1 To UBound(my_array)
b = my_array(j, 1) 'условие, что искать 1. указываем по каким столбцам диапазона искать
c = my_array(j, 2) 'условие, что искать 2. указываем по каким столбцам диапазона искать
        
    For i = 1 To UBound(a)
    If CStr(a(i, 1)) = CStr(b) And CStr(a(i, 3)) = CStr(c) Then 'в диапазоне, где искать указываем по каким столбцам диапазона
        Workbooks("пример11.xlsm").Worksheets(2).Cells(j, 3).Value = a(i, 4) 'куда вставлять найденное = что вставлять
        Exit For
    End If
    Next i
Next j
Application.ScreenUpdating = True
Debug.Print Timer - t
End Sub