С помощью VBA Excel можно легко создавать ZIP-архивы и распаковывать их без сторонних программ. Примеры процедур, которые создают и распаковывают ZIP-архивы.
Создание ZIP-архива
Код процедуры VBA Excel, создающей ZIP-архив:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 |
Sub CreateZipArchive() Dim oShell As New Shell32.Shell Dim oSourceFolder As Shell32.Folder Dim oZipFolder As Shell32.Folder Dim sourceFolder As String Dim zipFile As String Dim startTime As Double Dim timeoutSeconds As Double ' Укажите свои пути sourceFolder = "C:\Test\Лагенария\" zipFile = "C:\Test\Лагенария.zip" ' Проверка исходной папки Set oSourceFolder = oShell.Namespace(sourceFolder) If oSourceFolder Is Nothing Then MsgBox "Исходная папка '" & sourceFolder & "' не найдена или недоступна!", vbExclamation Exit Sub End If ' Создаем архив On Error Resume Next If Dir(zipFile) = "" Then CreateObject("Scripting.FileSystemObject").CreateTextFile(zipFile).Write "PK" & Chr(5) & Chr(6) & String(18, vbNullChar) If Err.Number <> 0 Then MsgBox "Ошибка при создании ZIP-файла: " & Err.Description, vbCritical Exit Sub End If End If On Error GoTo 0 ' Проверка ZIP-файла Set oZipFolder = oShell.Namespace(zipFile) If oZipFolder Is Nothing Then MsgBox "Не удалось создать или открыть ZIP-архив!", vbCritical Exit Sub End If ' Добавляем файлы oZipFolder.CopyHere oSourceFolder.Items ' Ждем завершения с тайм-аутом startTime = Timer timeoutSeconds = 30 Do Until oZipFolder.Items.Count = oSourceFolder.Items.Count Application.Wait (Now + TimeValue("0:00:01")) If Timer - startTime > timeoutSeconds Then MsgBox "Тайм-аут: процесс архивации не завершился за " & timeoutSeconds & " секунд.", vbExclamation Exit Sub End If Loop MsgBox "ZIP-архив успешно создан! (" & oZipFolder.Items.Count & " элементов)", vbInformation End Sub |
Настройка
- Откройте VBA Editor (Alt + F11).
- Перейдите в
Tools → References. - Подключите библиотеку
Microsoft Shell Controls And Automation. - Замените пути на свои и протестируйте код.
Примечания
- Код может быть значительно короче, но данный код учитывает больше возможных ошибок.
- Для объектов Shell используется ранняя привязка (для этого потребовалось подключить библиотеку Microsoft Shell Controls And Automation) — мне не удалось заставить его работать с поздней привязкой на своем компьютере.
Распаковка ZIP-архива
Код процедуры VBA Excel, распаковывающей ZIP-архив:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 |
Sub ExtractZipArchive() Dim oShell As Shell32.Shell Dim oZipFolder As Shell32.Folder Dim oExtractFolder As Shell32.Folder Dim zipFile As String Dim extractPath As String Dim startTime As Double Dim timeoutSeconds As Double ' Указываем пути zipFile = "C:\Test\Лагенария.zip" extractPath = "C:\Test\ЛагенарияКопия\" ' Инициализация Shell Set oShell = New Shell32.Shell ' Проверка существования архива If Dir(zipFile) = "" Then MsgBox "Архив '" & zipFile & "' не найден!", vbExclamation Exit Sub End If ' Проверка существования папки для распаковки, создание, если не существует On Error Resume Next If Dir(extractPath, vbDirectory) = "" Then MkDir extractPath If Err.Number <> 0 Then MsgBox "Не удалось создать папку для распаковки: " & Err.Description, vbCritical Exit Sub End If End If On Error GoTo 0 ' Устанавливаем объекты Set oZipFolder = oShell.Namespace(zipFile) If oZipFolder Is Nothing Then MsgBox "Не удалось открыть ZIP-архив!", vbCritical Exit Sub End If Set oExtractFolder = oShell.Namespace(extractPath) If oExtractFolder Is Nothing Then MsgBox "Не удалось открыть папку для распаковки!", vbCritical Exit Sub End If ' Извлекаем содержимое oExtractFolder.CopyHere oZipFolder.Items ' Ждем завершения с тайм-аутом startTime = Timer timeoutSeconds = 30 Do Until oExtractFolder.Items.Count = oZipFolder.Items.Count Application.Wait (Now + TimeValue("0:00:01")) If Timer - startTime > timeoutSeconds Then MsgBox "Тайм-аут: процесс распаковки не завершился за " & timeoutSeconds & " секунд.", vbExclamation Exit Sub End If Loop MsgBox "Архив успешно распакован! (" & oExtractFolder.Items.Count & " элементов)", vbInformation End Sub |
Где использовать?
Создание и распаковка ZIP-архивов средствами VBA Excel может быть полезным в различных автоматизированных сценариях, особенно когда требуется подготовка, передача или обработка файлов без участия стороннего ПО. Вот несколько практических случаев, когда эта возможность применяется:
1. Архивация отчётов перед отправкой по электронной почте
Если ваш макрос формирует отчёты или экспортирует данные (например, в PDF или CSV), вы можете автоматически поместить результат в ZIP-архив перед отправкой через Outlook или загрузкой на сервер. Это снижает размер файлов и упрощает пересылку.
2. Распаковка входящих архивов
Если пользователь получает архивы по электронной почте или загружает их с FTP/веб-портала, VBA Excel может автоматически извлечь нужные файлы для дальнейшей обработки, не требуя ручной распаковки.
3. Резервное копирование файлов
VBA может архивировать рабочие файлы перед изменением или удалением — как способ автоматического резервного копирования. Это особенно важно в системах, где Excel используется как часть инфраструктуры.
5. Передача нескольких файлов как одного
Если макрос генерирует несколько файлов (например, отчёты по отдельным объектам), упаковка их в ZIP позволяет удобно передать их в одном архиве, а не по отдельности.
6. Автоматизация обмена с другими системами
Некоторые внешние системы (например, API или корпоративные порталы) требуют приёма и передачи данных в формате ZIP. VBA может подготовить архив автоматически перед загрузкой.