Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
VBA Как изменить ГЛОБАЛЬНЫЕ уровни конфиденциальности в Параметрах запроса
 
#1
18.04.2019 12:34:39
Доброго времени суток, уважаемые!

Подскажите, пожалуйста, строки vba, которыми возможно менять уровни конфиденциальности в разделе «Параметры запроса»

Для корректной работы QP на различных машинах, необходимо постоянно устанавливать в параметрах «Всегда игнорировать параметры уровней конфиденциальности». Хотелось бы это дело автоматизировать.

Большое спасибо!






UPD:
Решение:


Код
Sub CreateNewZip(sPath As Str[SIZE=24pt][B][/B][/SIZE]ing)
    If Dir(sPath) <> "" Then Kill sPath
    Open sPath For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
End Sub


Sub ИзвлечьВсеИзАрхива()
    
    On Error Resume Next
    
    '===Переменные==================
    ПапкаДляАрхива = "C:\Users\" & Environ("UserName") & "\AppData\Local\Microsoft\Office\16.0\PowerQuery\User"
    ПутьДоАрхива = ПапкаДляАрхива & ".zip"
    '===============================
    
    
    
    MkDir ПапкаДляАрхива ' создаем папку с именем архива
    
    
    
    '===Извлекаем файлы из архива===
    With CreateObject("Shell.Application")
    .Namespace((ПапкаДляАрхива)).CopyHere .Namespace((ПутьДоАрхива)).Items
    End With
    '===============================
    
    
    
    
    
    '===Меняем содержимое SETTINGS.XLM===
    Workbooks.OpenXML Filename:= _
        ПапкаДляАрхива & "\UserInterface\Settings.xml" _
        , LoadOption:=xlXmlLoadImportToList

    Kill ПапкаДляАрхива & "\UserInterface\Settings.xml"

    Cells.Find(What:="GlobalPrivacyLevel", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
    Range("B" & Selection.Row).Value = "l0"

    ActiveWorkbook.SaveAsXMLData Filename:= _
        ПапкаДляАрхива & "\UserInterface\Settings.xml" _
        , Map:=ActiveWorkbook.XmlMaps("UISettingsConfig_карта")
        
      ActiveWorkbook.Close False
    '===============================
    
    
    
    
    
    Kill ПутьДоАрхива    ' удаляем старый архив

    CreateNewZip (ПутьДоАрхива) 'создаем пустой ZIP-архив
    
    
    '===Помещаем папку обратно в архив=====================================
    With CreateObject("Shell.Application").Namespace(("C:\Users\" & Environ("UserName") & "\AppData\Local\Microsoft\Office\16.0\PowerQuery\User.zip"))
    .CopyHere CreateObject("Shell.Application").Namespace(ПапкаДляАрхива).Items
    End With
    '======================================================================

    
    '===Дожидаемся окончания архивации=====================================
    Do Until CreateObject("Shell.Application").Namespace((ПутьДоАрхива)).Items.Count = CreateObject("Shell.Application").Namespace((ПапкаДляАрхива)).Items.Count
        DoEvents
    Loop
    '======================================================================

    Shell "cmd /c rd /S/Q """ & ПапкаДляАрхива & """"     'ЗАМЕТАЕМ СЛЕДЫ ( удаляем временную папку )
End Sub
Изменено: falmrom - 19.04.2019 10:58:43
Улыбнись.
 
 
 
#2
18.04.2019 14:04:29
Доброе время суток.
А вот не факт, что это доступно через объектную модель Excel. Косвенный подход. Настройки хранятся в файле UserInterface/Settings.xml архива по пути C:\Users\userLogin\AppData\Local\Microsoft\Office\16.0\PowerQuery\User.zip (для Excel 2016).
Параметры конфиденциальности, в зависимости от требований, определяются в нём так.
<Entry Type="GlobalPrivacyLevel" Value="l0" /> // Всегда игнорировать параметры уровней конфиденциальности
<Entry Type="GlobalPrivacyLevel" Value="l1" /> // Объединение данных в соответствии с настройками уровня конфиденциальности каждого файла
<Entry Type="GlobalPrivacyLevel" Value="l2" /> // Всегда объединять данные в соответствии с настройками уровня конфиденциальности для каждого источника

Так что формально через Shell.Application можно вытащить Settings.xml из архива, поменять для данного узла значение Value на требуемое, сохранить, обратно положить. Вот только предполагаю, что Excel Power Query такие настройки увидит только после следующего запуска.
Успехов.
 
 
 
#3
18.04.2019 16:11:04
Андрей VG, большое спасибо за столь содержательный и краткий ответ. Буду рыть в указанном Вами направлении. О результатах - сообщу. Спасибо!
Улыбнись.
 
 
 
#4
18.04.2019 16:58:09
Андрей VG, результат.  Код извлекает указанный Вами файл из архива в ту же папку, где лежит сам архив и отправляет его обратно в архив.

Код
Sub ExtractFileFromZip()
'====Извлекаем файл для дальнейшего редактирования=====================
    With CreateObject("Shell.Application").Namespace(("C:\Users\" & Environ("UserName") & "\AppData\Local\Microsoft\Office\16.0\PowerQuery"))
        .CopyHere "C:\Users\" & Environ("UserName") & "\AppData\Local\Microsoft\Office\16.0\PowerQuery\User.zip" & "\" & "UserInterface\Settings.xml"
    End With
'======================================================================



'
'
'Здесь код, который будет вносить изменения в Settings.xml
'
'




'====Помещаем файл обратно в архив=====================================
With CreateObject("Shell.Application").Namespace(("C:\Users\" & Environ("UserName") & "\AppData\Local\Microsoft\Office\16.0\PowerQuery\User.zip\UserInterface"))
.CopyHere "C:\Users\" & Environ("UserName") & "\AppData\Local\Microsoft\Office\16.0\PowerQuery\Settings.xml"
End With
'======================================================================
End Sub
Изменено: falmrom - 18.04.2019 16:58:23
Улыбнись.
 
 
 
#5
18.04.2019 17:00:29
Андрей VG, для меня остается загадкой как удалить файл из архива для подавления запроса о замене файла при следующей попытке копирования обратно в архив.
Улыбнись.
 
 
 
#6
18.04.2019 23:06:55
Цитата
falmrom написал:
как удалить файл из архива для подавления запроса о замене файла при следующей попытке копирования обратно в архив.
Удаление тоже потребует подтверждения. Тут Microsoft не гарантирует, что дополнительные флаги будут работать с CopyHere.
Цитата
each namespace can choose to ignore some or even all of these flags.
И в архивах действительно не работают :(
Так что лучше, наверное, распаковать всё в какую-то папку, отредактировать xml, удалить zip. И создать новый zip архив по местоназначению. Ну, или использовать нечто существующее в системе (вдруг у вас какой-нибудь winrar, winzip, 7zip с консольным управлением стоит).
 
 
 
#7
19.04.2019 08:27:46
Андрей VG, все гениальное - просто! Благодарю Вас за идею! Сейчас займусь реализацией. О результате сообщу.
Улыбнись.
 
 
 
#8
19.04.2019 09:11:51
Андрей VG,
код:
Код
Sub CreateNewZip(sPath As String)
    If Dir(sPath) <> "" Then Kill sPath
    Open sPath For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
End Sub


Sub ИзвлечьВсеИзАрхива()

    
    '===Переменные==================
    ПапкаДляАрхива = "C:\Users\" & Environ("UserName") & "\AppData\Local\Microsoft\Office\16.0\PowerQuery\User"
    ПутьДоАрхива = ПапкаДляАрхива & ".zip"
    '===============================
    
    
    
    MkDir ПапкаДляАрхива ' создаем папку с именем архива
    
    
    
    '===Извлекаем файлы из архива===
    With CreateObject("Shell.Application")
    .Namespace((ПапкаДляАрхива)).CopyHere .Namespace((ПутьДоАрхива)).Items
    End With
    '===============================
    
    
    
    
    '===Меняем содержимое SETTINGS.XML===
    '-------------
    '===============================
    
    
    
    
    Kill ПутьДоАрхива    ' удаляем старый архив

    CreateNewZip (ПутьДоАрхива) 'создаем пустой ZIP-архив
    
    
    '===Помещаем папку обратно в архив=====================================
    With CreateObject("Shell.Application").Namespace(("C:\Users\" & Environ("UserName") & "\AppData\Local\Microsoft\Office\16.0\PowerQuery\User.zip"))
    .CopyHere CreateObject("Shell.Application").Namespace(ПапкаДляАрхива).Items
    End With
    '======================================================================

    
    '===Дожидаемся окончания архивации=====================================
    Do Until CreateObject("Shell.Application").Namespace((ПутьДоАрхива)).Items.Count = CreateObject("Shell.Application").Namespace((ПапкаДляАрхива)).Items.Count
        DoEvents
    Loop
    '======================================================================
    
    Kill ПапкаДляАрхива     'ЗАМЕТАЕМ СЛЕДЫ ( удаляем временную папку )
End Sub
Изменено: falmrom - 19.04.2019 09:33:29
Улыбнись.
 
 
 
#9
19.04.2019 09:16:52
Андрей VG, теперь задача: научиться редактировать *.xml из VBA. Думаю сделать это через PQ. Пока что только это пришло в голову.
Андрей, есть предложения?

Up:
Изменено: falmrom - 19.04.2019 09:33:15
Улыбнись.
 
 
 
#10
19.04.2019 10:20:16
Андрей VG, полное решение:

Код
Sub CreateNewZip(sPath As String)
    If Dir(sPath) <> "" Then Kill sPath
    Open sPath For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
End Sub


Sub ИзвлечьВсеИзАрхива()
    
    On Error Resume Next
    
    '===Переменные==================
    ПапкаДляАрхива = "C:\Users\" & Environ("UserName") & "\AppData\Local\Microsoft\Office\16.0\PowerQuery\User"
    ПутьДоАрхива = ПапкаДляАрхива & ".zip"
    '===============================
    
    
    
    MkDir ПапкаДляАрхива ' создаем папку с именем архива
    
    
    
    '===Извлекаем файлы из архива===
    With CreateObject("Shell.Application")
    .Namespace((ПапкаДляАрхива)).CopyHere .Namespace((ПутьДоАрхива)).Items
    End With
    '===============================
    
    
    
    
    
    '===Меняем содержимое SETTINGS.XLM===
    Workbooks.OpenXML Filename:= _
        ПапкаДляАрхива & "\UserInterface\Settings.xml" _
        , LoadOption:=xlXmlLoadImportToList

    Kill ПапкаДляАрхива & "\UserInterface\Settings.xml"

    Cells.Find(What:="GlobalPrivacyLevel", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
    Range("B" & Selection.Row).Value = "l0"

    ActiveWorkbook.SaveAsXMLData Filename:= _
        ПапкаДляАрхива & "\UserInterface\Settings.xml" _
        , Map:=ActiveWorkbook.XmlMaps("UISettingsConfig_карта")
        
      ActiveWorkbook.Close False
    '===============================
    
    
    
    
    
    Kill ПутьДоАрхива    ' удаляем старый архив

    CreateNewZip (ПутьДоАрхива) 'создаем пустой ZIP-архив
    
    
    '===Помещаем папку обратно в архив=====================================
    With CreateObject("Shell.Application").Namespace(("C:\Users\" & Environ("UserName") & "\AppData\Local\Microsoft\Office\16.0\PowerQuery\User.zip"))
    .CopyHere CreateObject("Shell.Application").Namespace(ПапкаДляАрхива).Items
    End With
    '======================================================================

    
    '===Дожидаемся окончания архивации=====================================
    Do Until CreateObject("Shell.Application").Namespace((ПутьДоАрхива)).Items.Count = CreateObject("Shell.Application").Namespace((ПапкаДляАрхива)).Items.Count
        DoEvents
    Loop
    '======================================================================

    Shell "cmd /c rd /S/Q """ & ПапкаДляАрхива & """"     'ЗАМЕТАЕМ СЛЕДЫ ( удаляем временную папку )
End Sub
Изменено: falmrom - 19.04.2019 10:54:33
Улыбнись.
 
 
 
#11
19.04.2019 11:18:08
Андрей VG, а как Вы думаете, какой критерий запуска макроса можно использовать?
Например, я хочу запускать этот код при каждом запуске книги, если... (условие, при котором он запускается).
Улыбнись.
 
 
 
Страницы: 1
Наверх