Функция предназначена для получения файлов, извлечённых из архива ZIP.
Разархивирование выполняется средствами Windows, файлы извлекаются в специально созданную папку в каталоге для временных файлов (C:\WINDOWS\Temp\)
При запуске макроса папка UNZIPPED FILES сначала удаляется, а потом создаётся заново.
(таким образом, выполняется удаление файлов, которые могли оказаться в папке при предыдущем запуске макроса)
Функция возвращает коллекцию, содержащую полные пути к извлечённым файлам.
См. также функцию UnZip_File, предназначенную для разархивирования файлов
в заданную папку, с возможностью удаления исходного файла-архива.
Пример использования функции FilesFromZip:
Sub ПримерИспользования() On Error Resume Next file$ = "D:\Проекты\Прайсы\Архив.zip" ' путь к архиву, из которого будем извлекать файлы Dim coll As Collection Set coll = FilesFromZip(file) Debug.Print "Извлечено файлов: " & coll.Count ' выводи количество файлов For Each filename In coll ' выводим пути к извлечённым из архива ZIP файлам Debug.Print filename Next End Sub
Результат:
Извлечено файлов: 7
C:\WINDOWS\Temp\UNZIPPED FILES\Прайс лист BMW.xls
C:\WINDOWS\Temp\UNZIPPED FILES\Прайс лист LAMBO.xls
C:\WINDOWS\Temp\UNZIPPED FILES\Прайс лист Porche.xls
C:\WINDOWS\Temp\UNZIPPED FILES\Прайс лист ROVER.xls
C:\WINDOWS\Temp\UNZIPPED FILES\Прайс лист VAG.xls
C:\WINDOWS\Temp\UNZIPPED FILES\Прайс-лист Ford.xls
C:\WINDOWS\Temp\UNZIPPED FILES\Прайс-лист Мерседес.xls
Код функции FilesFromZip:
Для работы функции, необходимо дополнительно скопировать
в стандартный модуль код функции FilenamesCollection
Function FilesFromZip(ByVal FileNameZip) As Collection ' Функция осуществляет распаковку архива с именем FileNameZip во временную папку ' (предварительно удаляя папку с таким именем, если она существует) ' Возвращает коллекцию, содержащую пути ко всем извлечённым из архива файлам) On Error Resume Next: Err.Clear: Set FilesFromZip = New Collection folder = Environ("tmp") & "\UNZIPPED FILES\" Shell "cmd /c rd /S/Q """ & folder & """" ' удаляем папку DoEvents: DoEvents: DoEvents: DoEvents: MkDir folder ' и создаём эту папку заново DoEvents: DoEvents: DoEvents: DoEvents: Err.Clear If Len(Dir(folder, vbDirectory)) = 0 Then Exit Function ' не удалось создать папку If Len(Dir(FileNameZip)) = 0 Then MsgBox "Файл """ & FileNameZip & """ не найден!", _ vbCritical, "Ошибка в функции FilesFromZip": Exit Function Set oApp = CreateObject("Shell.Application") For Each it In oApp.Namespace(FileNameZip).Items: DoEvents: DoEvents: Next oApp.Namespace(folder).CopyHere oApp.Namespace(FileNameZip).Items 'распаковываем файлы Set FilesFromZip = FilenamesCollection(folder, "*") End Function
Другая версия функции, - работает более стабильно,
возвращает путь к файлу XLS из архива:
Function FileFromZip(ByVal FileNameZip) As String ' Функция осуществляет распаковку архива с именем FileNameZip во временную папку ' возвращает путь к разархивированному файлу Excel On Error Resume Next: Err.Clear folder = Environ("tmp") & "\UNZIP_" & Timer & "\" MkDir folder ' и создаём эту папку заново If Len(Dir(folder, vbDirectory)) = 0 Then Exit Function ' не удалось создать папку If Len(Dir(FileNameZip)) = 0 Then MsgBox "Файл """ & FileNameZip & """ не найден!", _ vbCritical, "Ошибка в функции FilesFromZip": Exit Function Set oApp = CreateObject("Shell.Application") For Each it In oApp.Namespace(FileNameZip).Items: DoEvents: DoEvents: Next oApp.Namespace(folder).CopyHere oApp.Namespace(FileNameZip).Items 'распаковываем файлы filename$ = folder & Dir(folder & "*.xls*", vbNormal) If Dir(filename$, vbNormal) Then FileFromZip = filename$ End Function
Комментарии
по поводу "Win8.1 - строчка "oApp.Namespace(Folder ).CopyHere oApp.Namespace(FileNameZip ).Items" почему-то не работает, файлы не распаковываются."
по видимому речь про функцию "Function FilesFromZip(ByVal FileNameZip) As Collection"
полагаю в ней ошибка аналогичная той, что не даёт работать "Function UnZip_File(ByVal FileNameZip, ByVal DestinationFolder, Optional ByVal DeleteSourceFile As Boolean = False) As Boolean"
достаточно указать в команде
oApp.Namespace(DestinationFolder).CopyHere oApp.Namespace(FullFileNameZip).Items 'распаковываем файлы
полный путь к распаковываемому файлу (FullFileNameZip = DestinationFolder + FileNameZip)
чтобы файлы начали успешно распаковываться
p.s. адиминистратору сайта - проверьте пожалуйста моё предположение, и если оно верно, внесите корректировки в код опубликованных на сайте макросов
Win8.1 - строчка "oApp.Namespace(Folder).CopyHere oApp.Namespace(FileNameZip).Items" почему-то не работает, файлы не распаковываются.
И по поводу самой концепции функции - обидно, что нельзя считывать структуру архива без дурацкой распаковыки всего и вся на диск
Здравствуйте, Сергей.
Этот макрос использует встроенные средства Windows для извлечения файлов из архива,
потому там нет возможностей программы WinRAR
Поэтому, надо использовать совсем другой макрос.
у рара есть опция распакавать только файлы удовлетворяющие определённой маске, пытаюсь воспользоваться этой опцией... не получается.. помогите плис
УРА!!!!!
Огромное ВАМ спасибо. Все заработало, дело действительно было в кавычках.
Можно указывать любые пути
PS: Код этот я не проверял, и, возможно, он заработает, только если добавить кавычки в путь к приложению (ибо он содержит пробел)
Вот так точно всё будет работать корректно:
(обратите внимание на двойные и тройные кавычки)
Доброго времени суток!
Спасибо за подробные разъяснения, но у меня сама программа отрабатывает но выскакивает сообщение: Архивы не найдены!
А можно ли путь к разархивированию указывать произвольный или обязательно через "C:\Temp\"
Sub UnRar()
WinRarApp$ = "C:\Program Files\WinRAR\WinRAR.exe e -o+"
iPath = "C:\Temp\АРХИВ RAR\"
iArhivName$ = "C:\Documents and Settings\Рабочий стол\Тest\346.rar"
adr$ = WinRarApp$ & " """ & iPath & iArhivName$ & """ """ & iPath & """ "
RetVal = Shell(adr$, vbHide) 'vbNormalFocus)
End Sub
Здравствуйте, Андрей.
Макрос предназначен только для архивов ZIP (c которыми Windows может работать сама, без привлечения сторонних программ)
С форматом архива RAR, увы, Windows не знакома, - поэтому тут надо привлекать сторонний софт (например, программу WinRAR)
Делается это примерно так: (и работает, кстати, быстрее и стабильнее, чем работа с ZIP папками средствами Windows)
PS: Правильнее было бы брать путь к программе WinRAR из реестра (ведь она может быть установлена в любую папку)
Но и в таком варианте код работает.
PS: У WinRAR есть множество ключей, с которыми можно его запускать (в примере макроса используются только 2 ключа),
так что можно очень гибко работать с архивами из макроса Excel
И, разумеется, таким образом (через WinRAR) можно работать с любыми типами архивов - не только RAR, но и ZIP, и т.д. и т.п.
Доброго времени суток!
У меня почему то временная папка создается а вот файл Архив.rar не распаковывается во временную папку "\UNZIPPED FILES\"?
Отправить комментарий