Пример того как можно создать архив, упаковать в него файл и извлечь этот файл из архива.
Иногда бывает необходимо архивировать документы, которые создает Access. Например, при электронной рассылке или резервном копировании. Для этого многие используют внешние архиваторы (7-Zip, WinRAR, WinZip, WinAce и т.д.) Но начиная с Windows XP для этого можно использовать возможности самой ОС. В Windows XP разработчики заложили возможность работоть с архивами формата ZIP как с папками. Такая возможность была давно реализована в различных файловых менеджерах ещё в DOS (знаменитый Norton Commander 5.0). Теперь такую возможность разработчики включили и в саму операционную систему.
Теперь давайте рассмотрим по шагам, как нам создать архив, записать в него файл и извлечь файл из архива.
Шаг первый. Создаем архивный файл.
Сделать это очень просто. Необходимо создать файл с нужным именем и расширением ZIP (это обязательно!). И записать в него заголовок ZIP файла. Например так:
'*************************************************************** Sub NewZip(sPath) If Len(Dir(sPath)) > 0 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 '***************************************************************
Или так:
'*************************************************************** Function CreateArchive(ZipArchivePath) As Boolean Dim Shell As Object Dim FileSystemObject As Object Dim ArchiveFolder As Object
Set Shell = CreateObject("Shell.Application") Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
' Проверка наличия расширения zip в полном пути-имени файла If UCase(FileSystemObject.GetExtensionName(ZipArchivePath)) <> "ZIP" Then Exit Function End If ' Создание пустого zip архива Dim ZipFileHeader As String ZipFileHeader = "PK" & Chr(5) & Chr(6) & String(18, 0) FileSystemObject.OpenTextFile(ZipArchivePath, 2, True).Write ZipFileHeader Set ArchiveFolder = Shell.NameSpace((ZipArchivePath)) ' проверка создания архива If Not (ArchiveFolder Is Nothing) Then CreateArchive = True End Function '***************************************************************
И помните! Необходимо указывать ПОЛНЫЙ ПУТЬ к создаваемому архиву. Обратите так же внимание на оператор Shell.NameSpace((ZipArchivePath)) Имя архивного файла должно быть заключено в двойные(!) скобки. Это особенности использования Shell. Если Вы подставляете вместо значений переменные, то Вы должны их заключать в двойные скобки. Иначе работать не будет! Теперь у нас создан архивный файл. Осталось записать в него нужный файл.
Шаг второй. Запись файла в архив.
Это тоже сделать не сложно. Например вот так
'*************************************************************** Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Sub CopyFileToArchiv(ZipName As String, FileName As String) ' ZipName - полный путь к архиву ' FileName - полный путь к архивируемому файлу Dim ShellApp As Object Dim DestFolder As Object
Set ShellApp = CreateObject("Shell.Application") Set DestFolder = ShellApp.NameSpace((ZipName)) ' копируемый выбранный файл в zip папку DestFolder.CopyHere (FileName) ' ожидаем окончание сжатия файла Do Until DestFolder.Items.Count = 1 Sleep 100 Loop
Set ShellApp = Nothing
End Sub '***************************************************************
Повторяю. Не забывайте про дополнительные скобки.
Шаг третий. Извлекаем файл из архива.
И в этом нет ничего сложного. Надо знать имя архивного файла (с полным путем) и то место, куда мы хотим извлечь файл из архива. Вот так.
'*************************************************************** Public Sub UnZipFile(ZipName As String, DestPath As String) ' ZipName - полный путь к архиву ' DestPath - полный путь к папке для распаковки архива
Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application") 'Copy the files in the newly created folder ShellApp.NameSpace((DestPath)).CopyHere ShellApp.NameSpace((ZipName)).Items Set ShellApp = Nothing
End Sub '***************************************************************
Вот и все основные действия. Можно так же узнать число файлов в архиве, их имена, размеры, даты модификации, типы и многое другое. Вот, например, как узнать количество файлов в архиве. '*************************************************************** Public Function fnCountItemsArchive(ZipName As String) As Integer ' ZipName - полный путь к архиву
Dim objShellApp As Object Dim objFolder As Object Dim objItems As Object
Set objShellApp = CreateObject("Shell.Application") Set objFolder = objShellApp.NameSpace((ZipName)) Set objItems = objFolder.Items() fnCountItemsArchive = objItems.Count
End Function '***************************************************************
А вот так можно узнать имена файлов в архиве. '*************************************************************** Public Function fnNameArchiveFile(ZipName As String, Optional i As Integer = 0, _ Optional fext As Boolean = True) As String ' ZipName - имя архива ' i - номер файла в архиве (начало с 0), по умолчанию - 0 ' fext - включать расширение в имя файла, по умолчанию - true Dim objShellApp As Object Dim objFolder As Object
Set objShellApp = CreateObject("Shell.Application") Set objFolder = objShellApp.NameSpace((ZipName)) If fext Then fnNameArchiveFile = objFolder.Items().Item((i)).Path Else fnNameArchiveFile = objFolder.Items().Item((i)).Name End If
End Function '*************************************************************** Всё остальное зависит от вашего желания и фантазии. В Windows 95/98/Me/2000 - не работает. В Vista - не тестировалось.
Используемые материалы.
http://forum.script-coding.info/viewtopic.php?id=296 - Серый форум http://www.rondebruin.nl/windowsxpzip.htm - Zip file or files with the default Windows zip program (VBA) http://sql.ru/forum/actualthread.aspx?bid=4&tid=468220&pg=-1&hl=zip - заZIPповать через WinXP (Latuk)
Очень много позаимствовано на форуме SQL.RU у пользователя Latuk. К статье прилагается небольшая база в формате Access 2000, которая и демонстрирует все вышеописанное.