При работе с запросами Power Query из Visual Basic for Application одной из распространенных задач является обновление запросов. Само по себе обновление запросов задача не сложная и сводится к единственной строке:
Sub RefreshAllQueries() ActiveWorkbook.RefreshAll End Sub |
Данный нехитрый код обновляет все запросы в активной(текущей) книге.
Но как правило целью подобных обновлений кодом является не просто обновление всех запросов, а автоматизация чего-либо(иначе проще было бы просто нажать кнопку на панели: Данные
- Необходимо обновить запрос(запросы) и считать данные, которые выгружены им в таблицу на листе, чтобы далее что-то с этими данными сделать
- Необходимо обновить запросы в нескольких книгах и сохранить эти книги после обновления, не открывая каждую из них вручную.
И здесь кроется главная проблема: метод
Sub RefreshAllQueries() ActiveWorkbook.RefreshAll MsgBox "Запросы обновлены", vbInformation, "www.excel-vba.ru" End Sub |
Можно будет увидеть, что сообщение
В принципе, можно зайти в свойства каждого запроса и отключить фоновое обновление: правая кнопка мыши на нужном запросе -Свойства
Что дает включение и отключение этой галочки? Все просто: если галочка установлена, то запрос обновляется "в фоне". Иначе говоря - параллельно с другими процессами. Т.е. мы можем нажать обновление запроса и одновременно с этим делать свои дела в Excel. Если же галочка снята, то запрос выполняется в модальном режиме. Т.е. как только мы запустили обновление запроса, мы вынуждены дожидаться его полного завершения и выгрузки, т.к. Excel не разрешит нам делать что-либо еще во время обновления.
Отсюда и появляются нюансы, которые могут помешать воспользоваться таким решением:
- Обновлять запросы в модальном режиме(не в фоновом) требуется как правило только в отдельных ситуациях, а не постоянно. При стандартной работе с файлом удобнее именно обновление в фоне. А это значит, что галочку придется постоянно "дергать"
- С файлом могут работать другие люди, которым модальное обновление может быть вообще не нужно и более того – оно будет их только раздражать. К тому же они могут банально включить обновление запросов в фоне, а мы об этом даже не узнаем. Как результат – у нас неверные данные.
Иными словами, использовать ручной метод решения проблемы можно, но только если другие варианты использовать нет возможности и только если мы можем это контролировать. А т.к. озвученные нами задачи все равно сводятся к использованию Visual Basic for Application(VBA), то мы просто воспользуемся возможностью изменения галочки "фоновое обновление", но делать все это будем именно через VBA.
- Обновление конкретного запроса в книге с кодом
- Обновление всех запросов в текущей(активной) книге
- Обновление всех запросов в книгах только выбранной папки
- Обновление всех запросов во всех книгах выбранной папки, включая все подпапки
В книге есть запрос с именем
Т.е. нам необходимо при помощи кода VBA запустить обновление запроса
По сути, самая главная часть как раз в самом обновлении. А копирование таблицы в другой лист просто демонстрация возможных действий, которые могут быть совершенно любыми: копирование, анализ, редактирование и т.п.
'--------------------------------------------------------------------------------------- ' Author : Щербаков Дмитрий(The_Prist) ' Профессиональная разработка приложений для MS Office любой сложности ' Проведение тренингов по MS Excel ' https://www.excel-vba.ru ' info@excel-vba.ru ' Purpose: Обновление запроса, с ожиданием его полного завершения ' и переносом полученных данных на лист "Сводная" '--------------------------------------------------------------------------------------- Sub RefreshNamedQuery() Const sQueryName As String = "Запрос — Бюджет" Dim IsBG_Refresh As Boolean, xQuery If Not IsQueryExists(ThisWorkbook, sQueryName) Then MsgBox "Запрос '" & sQueryName & "' не найден в книге '" & ThisWorkbook.Name & "'", vbInformation, "www.excel-vba.ru" Exit Sub End If 'обращаемся к конкретному запросу: "Запрос — Бюджет" (константа sQueryName) With ThisWorkbook.Connections(sQueryName) Set xQuery = Nothing 'необходимо обратиться к конкретному типу подключения 'в зависимости от типа запроса - определяем тип(.Type) Select Case .Type Case Excel.XlConnectionType.xlConnectionTypeODBC Set xQuery = .ODBCConnection Case Excel.XlConnectionType.xlConnectionTypeOLEDB Set xQuery = .OLEDBConnection Case Else 'запрос выгружен в таблицу на листе If .Ranges.Count > 0 Then Set xQuery = .Ranges(1).QueryTable End If End Select 'непосредственно обновление запроса с ожиданием окончания обновления If Not xQuery Is Nothing Then 'запоминаем значение обновления в фоне для запроса IsBG_Refresh = xQuery.BackgroundQuery 'выставляем принудительно ждать завершения запроса xQuery.BackgroundQuery = False 'обновляем запрос xQuery.Refresh 'возвращаем обновление в фоне в первоначальное состояние xQuery.BackgroundQuery = IsBG_Refresh End If End With 'теперь можно обращаться к результату обновленного запроса ' считывание данных с листа, копирование и т.п. 'копируем данные обновленного запроса как значения(без форматирования) 'и вставляем их на лист Сводный, начиная с первой пустой ячейки Dim wsResult As Worksheet, wsQuery As Worksheet Dim llastr As Long 'на этом листе выгружен наш запрос в умную таблицу с именем "Бюджет" Set wsQuery = ThisWorkbook.Worksheets("Запрос") 'на этом листе(Сводный) мы накапливаем результат каждого обновления запроса Set wsResult = ThisWorkbook.Worksheets("Сводный") 'получаем номер первой пустой строки на листе "Сводный" 'подробнее про получение последней ячейки: ' https://www.excel-vba.ru/chto-umeet-excel/kak-opredelit-pervuyu-zapolnennuyu-yachejku-na-liste/ llastr = wsResult.Cells.SpecialCells(xlCellTypeLastCell).Row If llastr < 2 Then 'итоговый лист еще пуст - надо скопировать всю умную таблицу с заголовками wsQuery.ListObjects("Бюджет").Range.Copy llastr = 1 Else 'данные на итоговом листе уже есть - надо скопировать все данные таблицы без заголовков wsQuery.ListObjects("Бюджет").DataBodyRange.Copy llastr = llastr + 1 End If 'вставляем скопированные данные таблицы запроса в итоговую таблицу 'начиная с первой пустой ячейки. Т.е. накопительно wsResult.Range("A" & llastr).PasteSpecial xlPasteValues 'сбрасываем буфер обмена Application.CutCopyMode = False MsgBox "Запрос '" & sQueryName & "' обновлен", vbInformation, "www.excel-vba.ru" End Sub '--------------------------------------------------------------------------------------- ' Author : Щербаков Дмитрий(The_Prist) ' Профессиональная разработка приложений для MS Office любой сложности ' Проведение тренингов по MS Excel ' https://www.excel-vba.ru ' info@excel-vba.ru ' Purpose: Функция проверяет наличие указанного запроса в книге ' Parameters ' wb - книга, в которой ищем нужный запрос ' sQueryName - имя искомого запроса '--------------------------------------------------------------------------------------- Function IsQueryExists(wb As Workbook, sQueryName As String) As Boolean Dim ws As Worksheet Dim lr As Long Dim oc 'перебираем в цикле все существующие запросы и подключения For Each oc In wb.Connections 'сверяем имя каждого с искомым If StrComp(sQueryName, oc.Name, 1) = 0 Then IsQueryExists = True End If Next End Function |
Код обновляет запрос, дожидается его завершения и переносит данные на лист "Сводный". Если на листе "Сводный" нет данных - то результат запроса переносится полностью, включая шапку таблицы(заголовки). Если же на листе "Сводный" уже есть данные - то переносятся все данные таблицы без заголовка, чтобы не дублировать заголовок.
Если заданный запрос отсутствует в книге - код выдаст сообщение о том, что такого запроса в этой книге нет. Тогда надо будет изменить имя запроса. Чтобы изменить имя запроса достаточно в строке
заменить текст внутри кавычек(
Узнать имя нужного запроса можно в свойствах: правая кнопка мыши на запросе -Свойства
Код ниже будет полезен, если надо обновить не один конкретный запрос, а все запросы в книге и дождаться их полного обновления:
'--------------------------------------------------------------------------------------- ' Author : Щербаков Дмитрий(The_Prist) ' Профессиональная разработка приложений для MS Office любой сложности ' Проведение тренингов по MS Excel ' https://www.excel-vba.ru ' info@excel-vba.ru ' Purpose: Код обновляет все запросы в текущей(активной) книге '--------------------------------------------------------------------------------------- Sub RefreshAllConnectionsAndWaitRefresh() Dim oc, xQuery Dim IsBG_Refresh As Boolean 'перебираем и обновляем все запросы в текущей(активной) книге For Each oc In ActiveWorkbook.Connections Set xQuery = Nothing Select Case oc.Type Case Excel.XlConnectionType.xlConnectionTypeODBC Set xQuery = oc.ODBCConnection Case Excel.XlConnectionType.xlConnectionTypeOLEDB Set xQuery = oc.OLEDBConnection Case Else 'запрос выгружен в таблицу на листе If oc.Ranges.Count > 0 Then Set xQuery = oc.Ranges(1).QueryTable End If End Select 'непосредственно обновление запроса с ожиданием окончания обновления If Not xQuery Is Nothing Then 'запоминаем значение обновления в фоне для запроса IsBG_Refresh = xQuery.BackgroundQuery 'выставляем принудительно ждать завершения запроса xQuery.BackgroundQuery = False 'обновляем запрос xQuery.Refresh 'возвращаем обновление в фоне в первоначальное состояние xQuery.BackgroundQuery = IsBG_Refresh End If Next MsgBox "Запросы обновлены", vbInformation, "www.excel-vba.ru" End Sub |
Если необходимо обновить несколько запросов в строго заданном порядке , то можно воспользоваться советами и кодами из этой статьи: Как обновить запросы Power Query(и не только) в указанном порядке?
В той же статье есть код, который выводит имена всех запросов книги на отдельный лист. Для чего нужно выводить имена запросов на лист? В случае с запросами Power Query может получиться так, что имя самого запроса отличается от того, который мы видим в свойствах и обновления может не произойти. Sub GetAllConnections()
Казалось бы, задача не сложная – тема перебора файлов не раз обсуждалась и я уже выкладывал подобные решения(например, в этой статье: Просмотреть все файлы в папке). И даже обновление запросов вроде бы при открытии каждого файла должно происходить(по умолчанию обновление запросов при открытии книги включено). Но на практике получается иначе: при открытии файла кодом как правило срабатывает метод RefreshAll все с тем же обновлением в фоне, что означает, что код может просто не дождаться завершения обновления всех запросов и закрыть книгу, так до конца и не обновив.
Поэтому я и выкладываю два кода по обновлению запросов во всех файлах в папке. Один обновляет просто файлы в папке, а второй обновляет запросы во всех файлах папки, включая подпапки до последней вложенной.
Комментарии в коде проставлены, лишние пояснения на мой взгляд избыточны.
'--------------------------------------------------------------------------------------- ' Author : Щербаков Дмитрий(The_Prist) ' Профессиональная разработка приложений для MS Office любой сложности ' Проведение тренингов по MS Excel ' https://www.excel-vba.ru ' info@excel-vba.ru ' Purpose: Код обновляет запросы во всех книгах выбранной папки '--------------------------------------------------------------------------------------- Option Explicit Sub RefreshAllFilesFromFolder() Dim sFolder As String, sFiles As String Dim wb As Workbook Dim oc, xQuery Dim IsBG_Refresh As Boolean 'диалог запроса выбора папки с файлами With Application.FileDialog(msoFileDialogFolderPicker) .Title = "www.excel-vba.ru" If .Show = False Then Exit Sub End If sFolder = .SelectedItems(1) End With sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator) 'отключаем обновление экрана, чтобы наши действия не мелькали Application.ScreenUpdating = False sFiles = Dir(sFolder & "*.xls*") Do While sFiles <> "" 'открываем книгу Set wb = Application.Workbooks.Open(sFolder & sFiles, False, False) 'если книга открыта и доступна для редактирования If Not wb Is Nothing Then 'обновляем все запросы в открытой книге For Each oc In wb.Connections On Error Resume Next 'необходимо обратиться к конкретному типу подключения 'в зависимости от типа запроса - определяем тип(.Type) Set xQuery = Nothing Select Case oc.Type Case Excel.XlConnectionType.xlConnectionTypeODBC Set xQuery = oc.ODBCConnection Case Excel.XlConnectionType.xlConnectionTypeOLEDB Set xQuery = oc.OLEDBConnection Case Else 'запрос выгружен в таблицу на листе If oc.Ranges.Count > 0 Then Set xQuery = oc.Ranges(1).QueryTable End If End Select 'непосредственно обновление запроса с ожиданием окончания обновления If Not xQuery Is Nothing Then Err.Clear 'запоминаем значение обновления в фоне для запроса IsBG_Refresh = xQuery.BackgroundQuery 'выставляем принудительно ждать завершения запроса xQuery.BackgroundQuery = False 'обновляем запрос xQuery.Refresh 'возвращаем обновление в фоне в первоначальное состояние xQuery.BackgroundQuery = IsBG_Refresh End If Next 'Закрываем книгу с сохранением изменений wb.Close True 'если поставить False - книга будет закрыта без сохранения и обновление запросов было бесполезным End If sFiles = Dir Loop 'возвращаем ранее отключенное обновление экрана Application.ScreenUpdating = True MsgBox "Запросы обновлены", vbInformation, "www.excel-vba.ru" End Sub |
'--------------------------------------------------------------------------------------- ' Author : The_Prist(Щербаков Дмитрий) ' Профессиональная разработка приложений для MS Office любой сложности ' Проведение тренингов по MS Excel ' http://www.excel-vba.ru ' info@excel-vba.ru ' WebMoney - R298726502453; Яндекс.Деньги - 41001332272872 ' Purpose: Обновление всех запросов во всех файлах папки, включая файлы в подпапках '--------------------------------------------------------------------------------------- Option Explicit Dim objFSO As Object, objFolder As Object, objFile As Object Sub RefreshAllFilesInAllFolders() Dim sFolder As String 'диалог запроса выбора папки с файлами With Application.FileDialog(msoFileDialogFolderPicker) .Title = "www.excel-vba.ru" If .Show = False Then Exit Sub End If sFolder = .SelectedItems(1) End With sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator) Application.ScreenUpdating = False Set objFSO = CreateObject("Scripting.FileSystemObject") 'просматриваем файлы в папке и всех подпапках GetSubFolders sFolder Set objFolder = Nothing Set objFSO = Nothing Application.ScreenUpdating = True MsgBox "Запросы обновлены", vbInformation, "www.excel-vba.ru" End Sub 'рекурсивная функция получения файлов в папке по заданному пути Private Function GetSubFolders(sPath As String) Dim sPathSeparator As String, sObjName As String Dim wb As Workbook Dim oc, xQuery Dim IsBG_Refresh As Boolean Set objFolder = objFSO.GetFolder(sPath) For Each objFile In objFolder.Files If Replace(objFile.Name, objFSO.GetBaseName(objFile), "") Like ".xls*" Then 'открываем книгу On Error Resume Next Set wb = Nothing Set wb = Application.Workbooks.Open(sPath & objFile.Name, False, False) 'если книга открыта и доступна для редактирования If Not wb Is Nothing Then 'обновляем все запросы в открытой книге For Each oc In wb.Connections On Error Resume Next 'необходимо обратиться к конкретному типу подключения 'в зависимости от типа запроса - определяем тип(.Type) Set xQuery = Nothing Select Case oc.Type Case Excel.XlConnectionType.xlConnectionTypeODBC Set xQuery = oc.ODBCConnection Case Excel.XlConnectionType.xlConnectionTypeOLEDB Set xQuery = oc.OLEDBConnection Case Else 'запрос выгружен в таблицу на листе If oc.Ranges.Count > 0 Then Set xQuery = oc.Ranges(1).QueryTable End If End Select 'непосредственно обновление запроса с ожиданием окончания обновления If Not xQuery Is Nothing Then Err.Clear 'запоминаем значение обновления в фоне для запроса IsBG_Refresh = xQuery.BackgroundQuery 'выставляем принудительно ждать завершения запроса xQuery.BackgroundQuery = False 'обновляем запрос xQuery.Refresh 'возвращаем обновление в фоне в первоначальное состояние xQuery.BackgroundQuery = IsBG_Refresh End If Next 'закрываем книгу с сохранением wb.Close True 'если поставить False - книга будет закрыта без сохранения End If End If Next For Each objFolder In objFolder.SubFolders GetSubFolders objFolder.Path & Application.PathSeparator Next End Function |
В приложенном файле все приведенные коды отдельными модулями и кнопками запуска. Так же в файле уже есть все озвученные выше таблицы и листы для тестирования работы кода по обновлению:
Дождаться обновления запроса.xlsm (186,7 КиБ, 133 скачиваний)
Так же см.:
Просмотреть все файлы в папке
Собрать данные из защищенных паролем файлов - PowerQuery
Как обновить запросы Power Query(и не только) в указанном порядке?
