PowerQuery очень мощный инструмент по работе с файлами
Если еще не работали с надстройкой PowerQuery и не знаете что это такое, то для начала лучше ознакомиться со статьей: Power Query - что такое и почему её необходимо использовать в работе?
Наиболее часто она применяется для сбора данных с листов и файлов. Я для примера возьму модель из своей статьи: Собрать и просуммировать данные из разных файлов при помощи PowerQuery. Там из папки отбираются все файлы Excel и объединяются в единую таблицу(плюс суммируются по критерию, но это сейчас неважно). Все работает отлично. Но если хотя бы на один файл будет установлен пароль на открытие запрос выдаст ошибку(
а если перейти в редактор запроса, то там будет ошибка вроде такой -
чтобы избежать ошибки при обновлении надо держать файл без пароля, что не всегда допустимо. Особенно, когда речь идет о бюджетах и лежат они где-то на сетевом диске. Можно вручную открыть каждый файл, снять пароль, сохранить книгу, закрыть, обновить запрос, а затем установить пароль на все книги заново. Метод хоть и надежный, но совсем не быстрый, если книг с паролем в папке хотя бы 5-10.
Сама модель PowerQuery не умеет(пока что) работать с защищенными паролем файлами и не может снять пароль с книг. Но это можно сделать при помощи Visual Basic for Applications(VBA). При этом код не такой уж сложный сам по себе, но нам надо учесть три вещи:
- Папка с файлами должна определяться кодом автоматически из запроса. Здесь мы можем пойти хитрым путем и указывать путь в умной таблице(подробно про такой подход я описывал в статье: Относительный путь к данным PowerQuery). Тогда код так же сможет получить путь к папке просто из таблицы параметров. Это значит что и запрос PowerQuery и код VBA будут использовать один и тот же путь и это не потребует от нас особых усилий. Плюс модель можно будет перемещать куда угодно - а это тоже большой плюс
- Код должен сам сначала открыть все файлы, снять с них пароль, сохранить и закрыть. После этого обновить запрос и дождаться его выполнения
- И последним шагом код должен установить пароль на файлы обратно. И только после завершения обновления запроса, не раньше
Код просмотра файлов в папке я уже когда-то давно приводил на сайте: Просмотреть все файлы в папке. Нам останется его немного модифицировать и сделать из него функцию, которая будет на основании переданных в неё параметров либо снимать пароль, либо устанавливать. Впрочем, ниже готовый код, в котором достаточно комментариев, чтобы уловить суть:
'--------------------------------------------------------------------------------------- ' Author : The_Prist(Щербаков Дмитрий) ' Профессиональная разработка приложений для MS Office любой сложности ' Проведение тренингов по MS Excel ' http://www.excel-vba.ru ' info@excel-vba.ru ' WebMoney - R298726502453; Яндекс.Деньги - 41001332272872 ' Purpose: '--------------------------------------------------------------------------------------- Option Explicit Sub RefreshPQ() 'вызываем функцию, убирающую пароль на открытие файлов Call ReOpenFiles(True, "1234") 'обновляем все запросы в книге 'если надо обновить только определенные ' -можно сделать это либо в одном конкретном листе ' (убрать цикл For Each ws In ThisWorkbook.Worksheets) ' -либо взять конкретный запрос(ws.QueryTables(1).Refresh) Dim ws As Worksheet, qt As QueryTable, oc As Object, IsBG_Refresh As Boolean For Each oc In ThisWorkbook.Connections 'запоминаем значение обновления в фоне для запроса IsBG_Refresh = oc.OLEDBConnection.BackgroundQuery 'выставляем принудительно ждать завершения запроса oc.OLEDBConnection.BackgroundQuery = False 'обновляем запрос oc.Refresh 'возвращаем обновление в фоне в первоначальное состояние oc.OLEDBConnection.BackgroundQuery = IsBG_Refresh Next ''======================================================= '' Если надо обновить только один запрос ' ' set oc = ThisWorkbook.Connections("Запрос — Бюджет") ' IsBG_Refresh = oc.OLEDBConnection.BackgroundQuery ' oc.OLEDBConnection.BackgroundQuery = False ' oc.Refresh ' oc.OLEDBConnection.BackgroundQuery = IsBG_Refresh ''======================================================= 'вызываем функцию, чтобы поставить обратно пароль на файлы Call ReOpenFiles(False, "1234") MsgBox "Запросы обновлены", vbInformation, "www.excel-vba.ru" End Sub 'функция открывает каждый файл в папке и удаляет/устанавливает пароль на открытие Function ReOpenFiles(IsDelPWD As Boolean, sPWD As String) Dim sFolder As String, sFiles As String Dim wb As Workbook Dim sNewPWD As String, sOldPWD As String 'определяем, убрать пароль на открытие или вернуть If IsDelPWD Then sOldPWD = sPWD sNewPWD = "" Else sOldPWD = "" sNewPWD = sPWD End If 'получаем путь к папке с файлами из "умной" таблицы "Parameters"(лист "Параметры") sFolder = Range("Parameters").Cells(1, 1).Value 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, Password:=sOldPWD) wb.Password = sNewPWD 'закрываем книгу с сохранением wb.Close True 'если поставить False - книга будет закрыта без сохранения sFiles = Dir Loop 'возвращаем ранее отключенное обновление экрана Application.ScreenUpdating = True End Function |
Почему в коде я применяю обновление всех запросов? Потому что я не знаю наверняка, только один запрос использует подключение к книгам или несколько. В смысле я-то точно знаю, что у меня такой запрос один. А вот один ли он будет всегда? Впрочем, в комментариях к коду я обозначил, что можно обновить один единственный запрос, если точно известно его имя(или номер):
' Если надо обновить только один запрос set oc = ThisWorkbook.Connections("Запрос — Бюджет") IsBG_Refresh = oc.OLEDBConnection.BackgroundQuery oc.OLEDBConnection.BackgroundQuery = False oc.Refresh oc.OLEDBConnection.BackgroundQuery = IsBG_Refresh |
Конечно, у кого-то точно возникнет вопрос: а что если для каждого файла будет свой пароль? Это уже другая история и в таком случае оптимально создавать список всех файлов на отдельном листе, где записывать имя файла и пароль для него. А уже кодом при просмотре файлов из папки сравнивать имена и при совпадении применять нужный пароль. Хотя я не очень приветствую такой подход, потому что файлы, собираемые в единый отчет лучше и создавать одинаково, в том числе и пароль давать единый. Это впоследствии избавит от многих проблем.
Модель сбора с защищенных файлов.zip (141,0 КиБ, 833 скачиваний)
Т.к. сама PowerQuery просматривает файлы не только в одной указанной папке, но и во всех подпапках - решил дополнить статью кодом, который так же просматривает все файлы не только в указанной папке, но и во всех её подпаках до самой глубоко вложенной. Так же в этом коде реализовано запоминание пароля для каждой книги, если он был установлен. Это может пригодиться, если пароль на открытие установлен не на все книги, а только на некоторые. Предыдущий код в этом случае после первого выполнения устанавливал пароль на открытие на все книги в папке.
'--------------------------------------------------------------------------------------- ' 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 Dim oPassDic As Object Sub RefreshPQ() Set oPassDic = CreateObject("scripting.dictionary") oPassDic.comparemode = 1 Application.StatusBar = "Снимаю пароль с файлов..." Application.DisplayAlerts = False 'чтобы не показывать окно пароля, если он неверный 'вызываем функцию, убирающую пароль на открытие файлов Call ReOpenFilesFromSubFolders(True, "1234") 'обновляем все запросы в книге 'если надо обновить только определенные ' -можно сделать это либо в одном конкретном листе ' (убрать цикл For Each ws In ThisWorkbook.Worksheets) ' -либо взять конкретный запрос(ws.QueryTables(1).Refresh) Dim ws As Worksheet, qt As QueryTable, oc As Object, IsBG_Refresh As Boolean Application.StatusBar = "Обновляю запросы..." For Each oc In ThisWorkbook.Connections 'запоминаем значение обновления в фоне для запроса IsBG_Refresh = oc.OLEDBConnection.BackgroundQuery 'выставляем принудительно ждать завершения запроса oc.OLEDBConnection.BackgroundQuery = False 'обновляем запрос oc.Refresh 'возвращаем обновление в фоне в первоначальное состояние oc.OLEDBConnection.BackgroundQuery = IsBG_Refresh Next ''======================================================= '' Если надо обновить только один запрос ' ' set oc = ThisWorkbook.Connections("Запрос — Бюджет") ' IsBG_Refresh = oc.OLEDBConnection.BackgroundQuery ' oc.OLEDBConnection.BackgroundQuery = False ' oc.Refresh ' oc.OLEDBConnection.BackgroundQuery = IsBG_Refresh ''======================================================= Application.StatusBar = "Устанавливаю пароль на файлы..." 'вызываем функцию, чтобы поставить обратно пароль на файлы Call ReOpenFilesFromSubFolders(False, "1234") Set oPassDic = Nothing Application.StatusBar = False Application.DisplayAlerts = True MsgBox "Запросы обновлены", vbInformation, "www.excel-vba.ru" End Sub 'функция открывает каждый файл в папке и всех подпапках ' и удаляет/устанавливает пароль на открытие ' если до этого на книгу не был установлен пароль - он не устанавливается Function ReOpenFilesFromSubFolders(IsDelPWD As Boolean, sPWD As String) Dim sFolder As String 'получаем путь к папке с файлами из "умной" таблицы "Parameters"(лист "Параметры") sFolder = Range("Parameters").Cells(1, 1).Value sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator) Application.ScreenUpdating = False Set objFSO = CreateObject("Scripting.FileSystemObject") 'просматриваем файлы в папке и всех подпапках GetSubFolders sFolder, IsDelPWD, sPWD Set objFolder = Nothing Set objFSO = Nothing Application.ScreenUpdating = True End Function Private Function GetSubFolders(sPath, IsDelPWD As Boolean, sPWD As String) Dim sPathSeparator As String, sObjName As String Dim wb As Workbook Dim sNewPWD As String, sOldPWD As String, spass As String 'определяем, убрать пароль на открытие или вернуть If IsDelPWD Then sOldPWD = sPWD sNewPWD = "" Else sOldPWD = "" sNewPWD = sPWD End If 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, Password:=sOldPWD) 'если пароль подошел и книга открыта If Not wb Is Nothing Then If IsDelPWD Then 'запоминаем текущий пароль к книге, если он есть If wb.HasPassword Then spass = sOldPWD Else spass = "" End If oPassDic.Add wb.FullName, spass wb.Password = "" Else 'устанавливаем пароль к книге, который был до этого spass = oPassDic.Item(wb.FullName) wb.Password = spass End If 'закрываем книгу с сохранением wb.Close True 'если поставить False - книга будет закрыта без сохранения End If End If Next For Each objFolder In objFolder.SubFolders GetSubFolders objFolder.Path & Application.PathSeparator, IsDelPWD, sPWD Next End Function |
Скачать модель обновления запроса и снятия пароля со всех файлов папки и подпапок:
Модель сбора с защищенных файлов включая подпапки.zip (137,8 КиБ, 689 скачиваний)
Кстати, функцию перебора файлов можно использовать отдельно и не только для снятия/установки пароля на открытие. Если чуть изменить, можно снимать пароли со всех листов всех книг. Для этого надо будет чуть изменить часть кода(надеюсь разберетесь какую часть надо заменить):
Dim ws As Worksheet Do While sFiles <> "" 'открываем книгу, убирая/устанавливая пароль на открытие Set wb = Application.Workbooks.Open(sFolder & sFiles, False, Password:=sOldPWD) wb.Password = sNewPWD For Each ws in wb.Worksheets If IsDelPWD Then ws.Unprotect Password:=sOldPWD Else ws.Protect Password:=sNewPWD End If Next 'закрываем книгу с сохранением wb.Close True 'если поставить False - книга будет закрыта без сохранения sFiles = Dir Loop |
Так же см.:
Обновить запросы к защищенным файлам [MulTEx]
Получить данные из файлов XML при помощи Power Query
Собрать и просуммировать данные из разных файлов при помощи PowerQuery
План-фактный анализ в Excel при помощи Power Query
Относительный путь к данным PowerQuery