Пароль для ZIP архива

Дата: Среда, 30.09.2015, 15:55 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 146

Репутация: 0 ±

Замечаний: 40% ±

2007

Уважаемы формучане, здравствуйте !
На одном из сайтов я нашел макрос, который из указанной папки добавляет в архив .zip все файлы. Макрос работает на ура. Я не могу придумать как на этот архив поставить пароль. Код в файле....

К сообщению приложен файл: _ZIP.xls (41.5 Kb)

Сообщение отредактировал A_3485 - Среда, 30.09.2015, 16:01

AndreTM

Дата: Среда, 30.09.2015, 22:27 | Сообщение № 2

Группа: Друзья

Ранг: Старожил

Сообщений: 1762

Репутация: 501 ±

Замечаний: 0% ±

2003 & 2010

Там используются средства встроенной в "Проводник" библиотеки работы с ZIP, а она вроде не поддерживает установку пароля на архив...

Skype: andre.tm.007
Donate: Qiwi: 9517375010

Дата: Четверг, 01.10.2015, 09:51 | Сообщение № 3

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 146

Репутация: 0 ±

Замечаний: 40% ±

2007

Может есть другой вариант создания ZIP с паролем.

AndreTM

Дата: Четверг, 01.10.2015, 10:20 | Сообщение № 4

Группа: Друзья

Ранг: Старожил

Сообщений: 1762

Репутация: 501 ±

Замечаний: 0% ±

2003 & 2010

Есть, естественно. Вызов любого внешнего архиватора (например, 7-Z, WinRar, WinZip) через шелл ОС с нужными параметрами... Почитайте там же то, что относится к WinRar.

Skype: andre.tm.007
Donate: Qiwi: 9517375010

Сообщение отредактировал AndreTM - Четверг, 01.10.2015, 10:38

Дата: Четверг, 01.10.2015, 10:52 | Сообщение № 5

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 146

Репутация: 0 ±

Замечаний: 40% ±

2007

На просторах инета нашел код:
[vba]

Код

Sub Запаковка_зип()
Dim MyPath As String, Suffix As String, MyName As String, Password As String, ShellArgument As String, ZipPathComand As String
MyPath = "C:\Desktop\Файл\"
ZipFullName = "C:\install\7-ZipPortable\7-ZipPortable.exe"
ZipPathComand = ZipPathCommand = ZipFullName & " a "

Suffix = "*.doc"
Password = "111"
MyName = Dir(MyPath & Suffix)
Do Until MyName = ""
MyName = MyPath & MyName
ShellArgument = ZipPathComand & Left(MyName, Len(MyName) - 4) & ".zip " & MyName & " -p" & Password
Shell (ShellArgument)
MyName = Dir
Loop
End Sub

[/vba]
При пошагой отработке кода, после строчки ZipPathComand = ZipPathCommand = ZipFullName & " a "
выдает что ZipPathComand = false, т.е что по указанному пути у меня неть zip.exe. Но через total именно по указанному пути я заупскаю 7-zip.exe.
Как быть я не знаю.

Сообщение отредактировал A_3485 - Четверг, 01.10.2015, 11:01

Дата: Пятница, 02.10.2015, 14:40 | Сообщение № 6

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 146

Репутация: 0 ±

Замечаний: 40% ±

2007

Нашел ошибку в шестрой строке (ZipPathComand = ZipPathCommand = ZipFullName & " a "), нужно было просто:
[vba]

Код

ZipPathComand = ZipFullName & " a "

[/vba]

И все равно ничего не архивируется. Открывается просто сама программа 7-ZIP.

К сообщению приложен файл: 0277764.png (25.2 Kb)

Дата: Суббота, 03.10.2015, 06:50 | Сообщение № 7

Группа: Друзья

Ранг: Ветеран

Сообщений: 770

Репутация: 255 ±

Замечаний: 0% ±

Excel 2013

в строке [vba]

Код

ShellArgument = ZipPathComand & Left(MyName, Len(MyName) - 4) & ".zip " & MyName & " -p" & Password

[/vba] добавьте пробел после -p (должно быть " -p ")

KSV.VBA@gmail.com
Яндекс.Деньги: 410011921213333

Дата: Понедельник, 05.10.2015, 09:17 | Сообщение № 8

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 146

Репутация: 0 ±

Замечаний: 40% ±

2007

Добавил пробел, все тоже самое.
[vba]

Код

ShellArgument = ZipPathComand & Left(MyName, Len(MyName) - 4) & ".zip " & MyName & " -p " & Password

[/vba]
Программа отрабатывает, открывается архиватор 7.zip и предлагает выбрать документы для архивации...

Дата: Понедельник, 05.10.2015, 23:37 | Сообщение № 9

Группа: Друзья

Ранг: Ветеран

Сообщений: 770

Репутация: 255 ±

Замечаний: 0% ±

Excel 2013

Может у вас пробелы в именах файлов?
Вот так попробуйте: [vba]

Код

ShellArgument = ZipPathComand & """" & Left(MyName, Len(MyName) - 4) & ".zip"" """ & MyName & """ -p" & Password

[/vba]
[p.s.]и пробел после -p не нужен - я вас прошлый раз дезинформировал, а сейчас посмотрел описание параметров командной строки (сам 7-zip не пользуюсь)[/p.s.]

UPD А какой исполняемый файл вы указали в ZipFullName? Нужно указывать именно консольную версию (т.е. 7z.exe, а не 7zFM.exe)
а судя по вашему описанию

Цитата A_3485, 05.10.2015 в 09:17, в сообщении № 8

открывается архиватор 7.zip и предлагает выбрать документы для архивации

у вас запускается графическая оболочка, а не консоль.

KSV.VBA@gmail.com
Яндекс.Деньги: 410011921213333

Сообщение отредактировал KSV - Вторник, 06.10.2015, 01:01

Дата: Вторник, 06.10.2015, 10:22 | Сообщение № 10

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 146

Репутация: 0 ±

Замечаний: 40% ±

2007

Пробелов в именах файлов нет. Запускаю 7zip.exe.
Чтобы пока на время облегчить мою участь, может есть способ открывать 7zip сразу по нужному адресу где находятся файлы для архивации, в моем случае это:
[vba]

Код

MyPath = "C:\Desktop\Файл\"

[/vba]

К сообщению приложен файл: 1466748.png (10.1 Kb)

Дата: Вторник, 06.10.2015, 22:44 | Сообщение № 11

Группа: Друзья

Ранг: Ветеран

Сообщений: 770

Репутация: 255 ±

Замечаний: 0% ±

Excel 2013

Цитата A_3485, 06.10.2015 в 10:22, в сообщении № 10

может есть способ открывать 7zip сразу по нужному адресу где находятся файлы для архивации

это не поможет, у вас проблема в том, что вместо консольной утилиты вы запускаете графическую оболочку архиватора.
Пошаговая инструкция:
1. качаете архиватор с оф. сайта 7-zip.org
2. устанавливаете (если не хотите устанавливать - просто распакуйте в какую-нибудь папку)
3. прописываете путь к 7z.exe в переменной ZipFullName
4. запускаете код [vba]

Код

Sub Запаковка_зип()
     Dim MyPath As String, Suffix As String, MyName As String, Password As String, ShellArgument As String, ZipFullName As String, ZipPathComand As String
     MyPath = "C:\Desktop\Файл\"
     ZipFullName = "C:\Tools\7-Zip\7z.exe" ' здесь пропишите свой путь
     ZipPathComand = ZipFullName & " a "

     Suffix = "*.doc"
     Password = "111"
     MyName = Dir(MyPath & Suffix)
     Do Until MyName = ""
         MyName = MyPath & MyName
         ShellArgument = ZipPathComand & """" & Left(MyName, Len(MyName) - 4) & ".zip"" """ & MyName & """ -p" & Password
         Shell ShellArgument, vbMinimizedNoFocus
         MyName = Dir
     Loop
End Sub

[/vba]
и получаете запароленные zip-архивы.

KSV.VBA@gmail.com
Яндекс.Деньги: 410011921213333

Дата: Среда, 07.10.2015, 13:22 | Сообщение № 12

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 146

Репутация: 0 ±

Замечаний: 40% ±

2007

KSV, спасибо за оказываемую помощь.
Установил с сайта архиватор 7zip. Код отрабатывает и архивирует каждый файл в отдельности.
Я сейчас пробую архивировать все файлы с расширением *.doc, *.xls а потом их удаляю. Программа отрабатывает но как-то криво.
Если запускаю пошаговою отработку кода через F8 то все ОК, если запускаю программу целико через F5 то выпадают глюки типа:
1). Формируется пустой архив;
2). Из 3 файлов формируется только 1 или 2;
3). формируется архив zip с 1 или двумя файлами и побочный файл с расширением .zip.tmp1
Данные глюки формируются циклично, т.е. первый архив пустой, второй архив с одним xls, третий архив с одним doc и т.д.
[vba]

Код

Sub Запаковка_зип()
     Dim MyPath As String, Suffix As String, MyName As String, Password As String, ShellArgument As String, ZipFullName As String, ZipPathComand As String
     MyPath = "C:\Desktop\Файл\"
     ZipFullName = "C:\install\7ZIP\7-zip\7z.exe"
     ZipPathComand = ZipFullName & " a "

     sDate = Format(Now, " ddmmyy_hhmmss")
     sZIPFileName = sZIPPath & "arhiv" & sDate & ".zip"

     Suffix = "*.*"
     Password = "111"
     MyName = Dir(MyPath & Suffix)

     Do Until MyName = ""
         If Right(MyName, 3) = "doc" Or Right(MyName, 3) = "xls" Then
         MyName = MyPath & MyName
         ShellArgument = ZipPathComand & """" & MyPath & sZIPFileName & """ """ & MyName & """ -p" & Password
         Shell ShellArgument, vbMinimizedNoFocus
         MyName = Dir
         Kill (MyName)
         Else:
         MyName = Dir
         End If
     Loop

End Sub

[/vba]

Код

Sub Запаковка_зип()
     Dim MyPath As String, Suffix As String, MyName As String, Password As String, ShellArgument As String, ZipFullName As String, ZipPathComand As String
     MyPath = "C:\Desktop\Файл\"
     ZipFullName = "C:\install\7ZIP\7-zip\7z.exe"
     ZipPathComand = ZipFullName & " a "

     sDate = Format(Now, " ddmmyy_hhmmss")
     sZIPFileName = sZIPPath & "arhiv" & sDate & ".zip"

     Suffix = "*.*"
     Password = "111"
     MyName = Dir(MyPath & Suffix)

     Do Until MyName = ""
         If Right(MyName, 3) = "doc" Or Right(MyName, 3) = "xls" Then
         MyName = MyPath & MyName
         ShellArgument = ZipPathComand & """" & MyPath & sZIPFileName & """ """ & MyName & """ -p" & Password
         Shell ShellArgument, vbMinimizedNoFocus
         MyName = Dir
         Kill (MyName)
         Else:
         MyName = Dir
         End If
     Loop

End Sub

[/vba]A_3485

К сообщению приложен файл: 2377420.png (4.7 Kb)

СообщениеKSV, спасибо за оказываемую помощь.
Установил с сайта архиватор 7zip. Код отрабатывает и архивирует каждый файл в отдельности.
Я сейчас пробую архивировать все файлы с расширением *.doc, *.xls а потом их удаляю. Программа отрабатывает но как-то криво.
Если запускаю пошаговою отработку кода через F8 то все ОК, если запускаю программу целико через F5 то выпадают глюки типа:
1). Формируется пустой архив;
2). Из 3 файлов формируется только 1 или 2;
3). формируется архив zip с 1 или двумя файлами и побочный файл с расширением .zip.tmp1
Данные глюки формируются циклично, т.е. первый архив пустой, второй архив с одним xls, третий архив с одним doc и т.д.
[vba]

Код

Sub Запаковка_зип()
     Dim MyPath As String, Suffix As String, MyName As String, Password As String, ShellArgument As String, ZipFullName As String, ZipPathComand As String
     MyPath = "C:\Desktop\Файл\"
     ZipFullName = "C:\install\7ZIP\7-zip\7z.exe"
     ZipPathComand = ZipFullName & " a "

     sDate = Format(Now, " ddmmyy_hhmmss")
     sZIPFileName = sZIPPath & "arhiv" & sDate & ".zip"

     Suffix = "*.*"
     Password = "111"
     MyName = Dir(MyPath & Suffix)

     Do Until MyName = ""
         If Right(MyName, 3) = "doc" Or Right(MyName, 3) = "xls" Then
         MyName = MyPath & MyName
         ShellArgument = ZipPathComand & """" & MyPath & sZIPFileName & """ """ & MyName & """ -p" & Password
         Shell ShellArgument, vbMinimizedNoFocus
         MyName = Dir
         Kill (MyName)
         Else:
         MyName = Dir
         End If
     Loop

End Sub

[/vba]

Автор - A_3485
Дата добавления - 07.10.2015 в 13:22

Дата: Четверг, 08.10.2015, 01:33 | Сообщение № 13

Группа: Друзья

Ранг: Ветеран

Сообщений: 770

Репутация: 255 ±

Замечаний: 0% ±

Excel 2013

Это происходит из-за асинхронного вызова Shell (архиватор еще не успел запаковать, а файл уже удален следующей командой).
Если после архивирования файл нужно удалять, то архиватор и сам умеет это делать, просто ему нужно об этом сказать (ключ -sdel).
И в последнем варианте кода вы наделали кучу ошибок!
Если вам нужно архивировать все файлы в один архив, то так:

а если каждый файл нужно архивировать отдельно, то так:

KSV.VBA@gmail.com
Яндекс.Деньги: 410011921213333

СообщениеЭто происходит из-за асинхронного вызова Shell (архиватор еще не успел запаковать, а файл уже удален следующей командой).
Если после архивирования файл нужно удалять, то архиватор и сам умеет это делать, просто ему нужно об этом сказать (ключ -sdel).
И в последнем варианте кода вы наделали кучу ошибок!
Если вам нужно архивировать все файлы в один архив, то так:

а если каждый файл нужно архивировать отдельно, то так:

Автор - KSV
Дата добавления - 08.10.2015 в 01:33

Дата: Четверг, 08.10.2015, 09:56 | Сообщение № 14

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 146

Репутация: 0 ±

Замечаний: 40% ±

2007

KSV, огромнейшее спасибо за помощь.
Разобрал каждую срочку в отдельности, оказалось что все очень просто. Теперь буду знать как используется функция InStr.
Еще раз спасибо

Сообщение отредактировал A_3485 - Четверг, 08.10.2015, 09:58