Страницы: 1
RSS
Обновление части файлов в папке, обновить данные в нескольких файлах, процедурой из отдельно созданного файла
 
Добрый день, уважаемые знатоки. Подскажите пожалуйста, есть несколько файлов в которых построены сводные по моделям данных, модели собраны из запросов. Эти файлы лежат в папке, в которой есть также другие файлы, которые не надо обновлять. Как можно осуществить автоматическое обновление этих (перечисленных) файлов без ручного открытия каждого и нажимания "данные - обновить все"?
Я предположила, что можно создать отдельный файл с макросом, который последовательно откроет, обновит, сохранит, закроет эти книги? Как обратиться к конкретным файлам (лежат статично никуда не перемещаются) Т.к. в макросах не сильна, хотелось бы знать в каком направлении копать
Код
Sub Макрос1()
'
' Макрос1 Макрос
''
    ActiveWorkbook.RefreshAll
    ActiveWorkbook.Save
    ActiveWindow.Close
End Sub
 
Обновление по именам файла, можете заменить условию, на свою при необходимости.

Код
Sub Obrabotka()
    Dim V As String
    Dim BrowseFolder As String, FSO As Object, SourceFolder As Object, subfolder As Object, File As Object
    Dim wb As Workbook
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Выберите папку или диск"
        .Show
        On Error Resume Next
        Err.Clear
        V = .SelectedItems(1)
        If Err.Number <> 0 Then
            MsgBox "Вы ничего не выбрали!"
            Exit Sub
        End If
    End With
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.GetFolder(CStr(V))

    For Each File In SourceFolder.Files
        
        If File.Name Like "*" & "Имя_файла" & "*" Then ' если имя файла содержит "Имя_файла" то обновляем
            Set wb = Workbooks.Open(File, 0)
            wb.RefreshAll
            wb.Close True
        End If
        
    Next File
    Application.ScreenUpdating = True: Application.DisplayAlerts = True


    Set File = Nothing: Set SourceFolder = Nothing: Set FSO = Nothing
End Sub
Изменено: nbaengineer - 29.01.2022 15:05:16
Вредить легко, помогать трудно.
 
Очень круто. Обновляет даже визуально не открывая файлы! даже по части названия файла можно отделить все нужные мне для обновления.
Спасибо большущее!
Изменено: Наталия - 29.01.2022 16:42:43
 
У меня этот макрос не работает. Шуршит, перебирает файлы, сохраняет.
Но в файлах, которыми он пошуршал, запросы остаются необновленными.

Наляпанный руками макрос
Код
Sub refresh()
 ActiveWorkbook.RefreshAll
End Sub
в открытых файлах работает нормально.
Excel365
На обновление каждому файлу надо примерно минуту, если тыцать руками "Обновить все" в открытом файле. Макрос шуршит каждым файлом секунд по 5.
На этом мысль остановилась...
/их похожих обсуждений на форуме пока мало что поняла, но галочка "Разрешить фоновое обновление" у меня всегда снята.
Изменено: Xel - 26.08.2022 20:03:26
 
Xel, попробуйте в коде из сообщения #2 после (строка 25):
Код
wb.RefreshAll
добавить строку:
Код
DoEvents

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
Код
        If File.Name Like "*" & "вСборку" & "*" Then ' если имя файла содержит "Имя_файла" то обновляем
            Set wb = Workbooks.Open(File, 0)
            wb.RefreshAll
          DoEvents
               
            wb.Close True


Вот так? Не работает. Шуршит, сохраняет, запросы не обновлены  :cry:
И тоже занимается с каждым файлом заметно меньше, чем занял бы ручной тыц.
Изменено: Xel - 26.08.2022 20:41:47
 
Xel, сделайте 2-3 файла с запросами, которые макросом не обновляются (чтобы скачавший мог воспроизвести у себя Вашу ситуацию). Файлы в архив (соблюдайте ограничение на объём файла) и приложите к сообщению. Тогда можно будет попытаться разобраться в чём проблема. У меня других мыслей нет по этому поводу.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
Вообще любой запрос. Например, вот файл.
Меняется время сохранения, не обновляется запрос - таблица берется с листа и высыпается рядом.
В процессе в центре управления безопасности разрешила подключение ко всем внешним данным, теперь не ругается на это. Не помогло.
 
Помогает закомментить строку

Код
          wb.Close True 

Если файл остается открытым после выполнения макроса, запрос обновляется.

Стоит ли там    DoEvents перед этой строкой при этом значения не имеет.
 
тестируйте
Решение взято отсюда.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
Спасибо, я в том треде перестала понимать дискуссию задолго до этого сообщения :oops:
Проверю в понедельник.
Но поныть на тему - что не так и почему у ТС refreshall работает можно прямо сейчас :oops:
 
Код
Sub Obrabotka()
    Dim V As String
    Dim BrowseFolder As String, FSO As Object, SourceFolder As Object, subfolder As Object, File As Object
    Dim wb As Workbook
    Dim IsBG_Refresh As Boolean, oc
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Выберите папку или диск"
        .Show
        On Error Resume Next
        Err.Clear
        V = .SelectedItems(1)
        If Err.Number <> 0 Then
            MsgBox "Вы ничего не выбрали!"
            Exit Sub
        End If
    End With
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
     
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.GetFolder(CStr(V))
 
    For Each File In SourceFolder.Files
         
        If File.Name Like "*" & "Имя_файла" & "*" Then ' если имя файла содержит "Имя_файла" то обновляем
            Set wb = Workbooks.Open(File, 0)
            With wb
               For Each oc In .Connections        'запоминаем значение обновления в фоне для запроса
                   IsBG_Refresh = oc.OLEDBConnection.BackgroundQuery
                   'выставляем принудительно ждать завершения запроса
                   oc.OLEDBConnection.BackgroundQuery = False
                   'обновляем запрос
                   oc.Refresh
                   'возвращаем обновление в фоне в первоначальное состояние
                   oc.OLEDBConnection.BackgroundQuery = IsBG_Refresh
               Next
               .RefreshAll
               .Close True
            End With
        End If
         
    Next File
    Application.ScreenUpdating = True: Application.DisplayAlerts = True
 
 
    Set File = Nothing: Set SourceFolder = Nothing: Set FSO = Nothing
End Sub


Итоговый макрос, с выбором папки и шаблоном для имени файла.
Строку .RefreshAll я оставила, мне во всех файлах после обновления запросов надо старорежимные сводные обновлять.
Для обновления запросов она не нужна.

Спасибо большое!
 
Народ, а как сюда прописать адрес папки, которую надо обновлять, чтобы не выбирать каждый раз?
Страницы: 1
Наверх