MyTetra Share
Делитесь знаниями!
АРХИВАЦИЯ - ИЗВЛЕЧЕНИЕ ИЗ АРХИВА ЧЕРЕЗ VBA
30.01.2018
09:09
Текстовые метки: k_zip,vba,zip
Раздел: VBA

АРХИВАЦИЯ - ИЗВЛЕЧЕНИЕ ИЗ АРХИВА ЧЕРЕЗ VBA

 


В данной статье я постараюсь описать и показать, как можно средствами Visual Basic for Applications создать архив и извлечь данные из архива(иными словами архивировать и разархивировать файлы).

Архивация через WinRAR:

§  Общая процедура вызова функций архивации/разархивации;

§  Архивация папки - WinRAR;

§  Архивация файла - WinRAR;

§  Извлечение из архива папки/файла - WinRAR;

§  Описание параметров WinRAR;

§  Таблица команд WinRAR;

§  Таблица ключей WinRAR;

§  Таблица параметров окна для Shell;

Архивация встроенными средствами Windows(в ZIP):

§  Основная процедура создания пустого ZIP-архива;

§  Архивация выбранных файлов;

§  Создание архива из всех файлов в указанной папке;

§  Создание архива с резервной копией активной книги;

§  Извлечение из архива конкретного файла;

§  Извлечение всех файлов из архива.



АРХИВАЦИЯ ЧЕРЕЗ WinRAR
В принципе, все очень даже просто. В функция для архивации и извлечения используется архиватор 
WinRAR, т.к. он является самым распространенным и есть почти на каждом ПК. Процедура CallRARFunction показывает как можно вызвать функции работы с WinRAR-ом. Остальные функции выполняют непосредственно всю "грязную" работу. Я специально решил привести пример с процедурой вызова и отдельными функциями. Чтобы при необходимости можно было функции записать, а вызов выполнять уже где угодно.

Первое обязательное условие для вызова всех функций - необходимо объявить константу с путем к исполняемому файлу архиватора WinRAR:


1

2

Option Explicit

Const sWinRarAppPath As String = "C:\Program Files\WinRAR\WinRAR.exe"

Данные две строки помещаются в самый верх модуля, в котором будут описаны функции работы с архивами. Указывается полный путь к файлу WinRAR.exe. В строке выше указан путь, по которому WinRAR устанавливается по умолчанию. Однако если WinRAR установлен в другую папку - необходимо указать её. Например: "C:\Обязательные программы\WinRAR\WinRAR.exe"


 
ОБЩАЯ ПРОЦЕДУРА ВЫЗОВА ФУНКЦИЙ АРХИВАЦИИ/РАЗАРХИВАЦИИ


1

2

3

4

5

6

7

8

9

10

11

12

13

14

Sub CallRARFunction()

    'Архивируем папку "C:\Temp\Тест"

    If FolderToRAR("C:\Temp\Тест") Then

        MsgBox "Папка успешно заархивирована!", vbInformation, "www.excel-vba.ru" '

    End If

    'Архивируем файл C:\Temp\Test.xls

    If FileToRAR("C:\Temp\", "Test.xls", "Test.rar") Then

        MsgBox "Файл успешно заархивирован!", vbInformation, "www.excel-vba.ru" '

    End If

    'Извлекаем из архива "C:\Temp\Test" файлы в папку с архивом "C:\Temp\" '

    If UnRAR("C:\Temp\Test", "Test.rar") Then

        MsgBox "Файлы успешно распакованы!", vbInformation, "www.excel-vba.ru" '

    End If

End Sub




 
АРХИВАЦИЯ ПАПКИ - WINRAR


1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

'---------------------------------------------------------------------------------------

' Procedure : FolderToRAR

' Author    : The_Prist(Щербаков Дмитрий)

'             WebMoney - R298726502453; Яндекс.Деньги - 41001332272872

'             http://www.excel-vba.ru

' Purpose   : Функция архивирует указанную папку

'             sPath       - путь к папке для архивации

'---------------------------------------------------------------------------------------

Function FolderToRAR(sPath As String)

    Dim sArhiveName As String

    Dim sWinRarApp As String

    sWinRarApp = sWinRarAppPath & " A -ep " '

    sArhiveName = sPath & ".rar" '

    'добавляем двойные кавычки, что позволит нам работать с именем файла и путём, которые содержат пробелы.

    'без кавычек пробелы недопустимы

    FolderToRAR = Shell(sWinRarApp & " """ & sArhiveName & """ """ & sPath & """ ", vbHide)

End Function




 
АРХИВАЦИЯ ФАЙЛА - WINRAR


1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

'---------------------------------------------------------------------------------------

' Procedure : FileToRAR

' Author    : The_Prist(Щербаков Дмитрий)

'             WebMoney - R298726502453; Яндекс.Деньги - 41001332272872

'             http://www.excel-vba.ru

' Purpose   : Функция архивирует указанный файл

'             sPath       - путь к файлу для архивации

'             sFileName   - имя файла для архивации

'             sArhiveName - имя результирующего архива

'---------------------------------------------------------------------------------------

Function FileToRAR(sPath As String, sFileName As String, ByVal sArhiveName As String)

    Dim sWinRarApp As String

    'архивируем файл с удалением самого файла после архивации(за это отвечает параметр -df )

    sWinRarApp = sWinRarAppPath & " A -ep -df "

    'добавляем двойные кавычки, что позволит нам работать с именем файла и путём, которые содержат пробелы.

    'без кавычек пробелы недопустимы

    FileToRAR = Shell(sWinRarApp & " """ & sPath & sArhiveName & """ """ & sPath & sFileName & """ ", vbHide)

End Function




 
ИЗВЛЕЧЕНИЕ ИЗ АРХИВА ПАПКИ/ФАЙЛА - WINRAR


1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

'---------------------------------------------------------------------------------------

' Procedure : UnRAR

' Author    : The_Prist(Щербаков Дмитрий)

'             WebMoney - R298726502453; Яндекс.Деньги - 41001332272872

'             http://www.excel-vba.ru

' Purpose   : Функция извлекает данные из указанного архива в папку с файлом архива

'             sPath       - путь к архиву

'             sArhiveName - имя архива

'---------------------------------------------------------------------------------------

Function UnRAR(sPath As String, sArhivName As String)

    Dim sWinRarApp As String

    'извлекаем данные из архива в скрытом окне(vbHide)

    'с перезаписью существующих файлов (-o+)

    sWinRarApp = sWinRarAppPath & " E -o+ "

    'добавляем двойные кавычки, что позволит нам работать с именем файла и путём, которые содержат пробелы.

    'без кавычек пробелы недопустимы

    UnRAR = Shell(sWinRarApp & " """ & sPath & "\" & sArhivName & """ """ & sPath & """ ", vbHide)

End Function



Ничего сложного - функции делают одно - вызывают посредством объекта Shell архиватор WinRAR, передавая ему указанные параметры. Для большинства задач функции вполне подойдут без каких-либо изменений. Если лень разбираться - можно просто последовательно скопировать ВСЕ коды данной статьи и вставить их в стандартный модуль.
А для тех, кто хочет углубиться и поэкспериментировать - можно почитать дальше и узнать какие можно применить команды и ключи для более гибкого использования WinRAR вместе с VBA.
Синтаксис передачи параметров WinRAR:
WinRAR [<strong>команда</strong>] -[<strong>ключ1</strong>] -[<strong>ключN</strong>] [<strong>архив</strong>] [<strong>файлы…</strong>] [<strong>@файл-список…</strong>] [<strong>путь для извлечения</strong>\]

 
ОПИСАНИЕ ПАРАМЕТРОВ WinRAR

Параметр

Описание

команда

Комбинация символов, определяющая действие, которое будет выполнять WinRAR.

ключ

Ключи используются для определения специфических действий, степени сжатия, типа архива и пр.

архив

Имя обрабатываемого архива.

файлы

Имена обрабатываемых файлов.

файл-список

Файлы-списки - это обычные текстовые файлы, содержащие имена файлов для обработки. Каждое имя файла должно быть указано на отдельной строке и начинаться с первой позиции строки. В файл-список допускается помещать комментарии, признак начала комментария - символы //. Например, для архивирования файлов *.txt из папки c:\work\doc, файлов *.bmp из папки c:\work\image и всех файлов из папки c:\work\misc можно создать backup.lst, содержащий следующие строки:
c:\work\doc\*.txt//резервная копия текстовc:\work\image\*.bmp//резервная копия рисунковc:\work\misc

После этого для архивирования достаточно будет выполнить команду:
winrar a backup @backup.lst

В одной командной строке разрешается указывать как обычные имена или группы файлов для обработки, так и файлы-списки. Если не указаны ни файлы, ни файлы-списки, то подразумевается шаблон *.* (т.е. WinRAR обработает все файлы).

путь для извлечения

Используется только с командами e и x и указывает папку, в которую нужно извлекать файлы. Если эта папка не существует, то она будет создана.

В одну строку можно передать сразу несколько команд и ключей. Главное, чтобы порядок их не противоречил синтаксису передачи параметров. Сначала необходимые команды, далее ключи и т.д. Например, в функции FileToRAR я использую команду и два параметра - " A -ep -df ". Если все перевести в одну строку, заменив все переменные значениями, то получится такая строка:
Shell("C:\Program Files\WinRAR\WinRAR.exe A -ep -df ""C:\Temp\Test.rar "" ""C:\Temp\Test.xls"" ", vbHide)
Попробуем прочитать строку:
WinRAR должен поместить в архив файл C:\Temp\Test.xls, имя создаваемого архива - C:\Temp\Test.rar. После успешной архивации исходный файл C:\Temp\Test.xls будет удален(ключ -df). Пути в именах не отображаются(ключ -ep).
Команду я записал с большой буквы для визуального разделения, но этого не требуется, ключи и команды не чувствительны к регистру. Ниже я привожу таблицы с перечислением и расшифровкой всех команд и функций, доступных в WinRAR. Так же их всегда можно посмотреть в справке самого WinRAR.


 
ТАБЛИЦА КОМАНД WINRAR

Раскрыть таблицу »


 
ТАБЛИЦА КЛЮЧЕЙ WINRAR
Чуть подробнее стоит остановиться на ключах к WinRAR. Их использование значительно расширяет возможности архивирования и дальнейшей обработки файлов. Для чего они нужны и как применить? Очень просто. Если взглянуть на функции, приведенные выше, то можно увидеть пару примеров использования ключей и команд.
Ниже приведена полная таблица ключей и их описание:

Скрыть «

Ключ

Описание ключа

-ac

Снять атрибут "архивный" после архивации или извлечения

-ad

Добавить к пути назначения имя архива

-af<тип>

Указать формат архива

-ag[формат]

Добавить к имени архива текущую дату и время

-ao

Добавить файлы с установленным атрибутом "архивный"

-ap<путь>

Установить путь внутри архива

-as

Синхронизировать содержимое архива

-av

Добавить электронную подпись

-av-

Запретить добавление/проверку электронной подписи

-cfg-

Игнорировать профиль по умолчанию и переменную окружения

-cl

Преобразовать имена файлов в нижний регистр

-cu

Преобразовать имена файлов в верхний регистр

-df

Удалить файлы после архивации

-dh

Открывать совместно используемые файлы

-ds

Не сортировать файлы при архивации

-ed

Не добавлять пустые папки

-en

Не добавлять блок "конец архива"

-ep

Исключить пути из имён

-ep1

Исключить из пути базовую папку

-ep2

Сохранять полные пути файлов

-ep3

Сохранять полные пути, включая букву диска

-e[+]<атр>

Задать исключение или включение файлов из/в обработку по маске атрибутов

-f

Освежить имеющиеся файлы

-hp[пароль]

Шифровать и данные, и заголовки файлов

-iadm

Запрашивать административный доступ для SFX-архива

-ibck

Запустить WinRAR как фоновый процесс в системном лотке

-ieml[.][адрес]

Отправить архив по электронной почте

-iicon<имя >

Указать значок для SFX-модуля

-iimg<имя>

Указать логотип для SFX-модуля

-ilog[имя]

Записывать протокол ошибок в файл

-inul

Не выводить сообщения об ошибках

-ioff

Выключить компьютер

-k

Заблокировать архив

-kb

Сохранять на диске файлы, извлечённые с ошибками

-m<n>

Установить метод сжатия

-mc<параметры>

Указать дополнительные параметры сжатия

-md<n>

Установить размер словаря

-ms[список]

Указать типы файлов для архивирования без сжатия

-mt<потоки>

Установить число потоков

-n<файл>

Включить в обработку только указанный файл

-n@<файл-список>

Включить в обработку только файлы, указанные в файле-списке

-oc

Установить NTFS-атрибут "сжатый"

-or

Переименовывать файлы автоматически

-os

Сохранить потоки NTFS

-ow

Обработать информацию о правах доступа к файлам

-o+

Перезаписывать существующие файлы

-o-

Не перезаписывать существующие файлы

-p[пароль]

Установить пароль

-r

Обрабатывать вложенные папки

-r0

Обрабатывать вложенные папки по шаблону

-ri

Установить приоритет и время простоя

-rr[N]

Добавить информацию для восстановления

-rv[N]

Создать тома для восстановления

-s

Создать непрерывный архив

-s<N>

Создать непрерывные группы, используя счётчик файлов

-sc<набор символов>[объекты]

Указать набор символов (и объекты)

-se

Создать непрерывные группы, используя расширения файлов

-sfx[имя]

Создать самораспаковывающийся архив

-sl<размер>

Обрабатывать файлы размером меньше указанного

-sm<размер>

Обрабатывать файлы размером больше указанного

-sv

Создать независимые непрерывные тома

-sv-

Создать зависимые непрерывные тома

-s-

Запретить создание непрерывных архивов

-t

Протестировать файлы после архивирования

-ta<дата>

Обрабатывать файлы, изменённые после указанной даты

-tb<дата>

Обрабатывать файлы, изменённые до указанной даты

-tk

Сохранять исходное время архива

-tl

Установить время архива по самому новому файлу

-tn<время>

Обрабатывать файлы не старее, чем указанный период времени

-to<время>

Обрабатывать файлы более старые, чем указанный период времени

-ts<m,c,a>

Сохранить/восстановить время файлов (модификации, создания, последнего доступа)

-u

Обновить файлы

-v<n>[k |b|f|m|M|g|G]

Создать многотомный архив

-vd

Очищать сменный диск перед архивацией на него

-ver[n]

Управление версиями файлов

-vn

Использовать старую схему именования томов

-vp

Делать паузу перед каждым томом

-x<файл >

Не обрабатывать указанный файл

-x@<файл-список >

Не обрабатывать файлы, указанные в файле-списке

-y

Подразумевать ответ "Да" на все запросы

-z<файл>

Прочитать комментарий архива из файла

--

Прервать дальнейший поиск ключей в командной строке




 
ТАБЛИЦА ПАРАМЕТРОВ ОКНА ДЛЯ SHELL
И таблица параметров и их значений для команды Shell, через которую осуществляется вызов архиватора:

Скрыть «

Параметр

Значение параметра

vbNormalFocus

Будет показан ход выполнения архивации

vbHide

Окно архиватора будет скрыто

vbMinimizedFocus

Окно архиватора будет свернуто

vbMinimizedNoFocus

Окно архиватора будет свернуто, а окно вызвавшей программы активировано

vbMaximizedFocus

Окно архиватора будет раскрыто на весь экран и активировано



 
 
АРХИВАЦИЯ ВСТРОЕННЫМИ СРЕДСТВАМИ Windows(в ZIP):

ОСНОВНАЯ ПРОЦЕДУРА СОЗДАНИЯ ПУСТОГО ZIP-АРХИВА
 


1

2

3

4

5

6

7

8

9

10

11

12

13

'---------------------------------------------------------------------------------------

' Procedure : CreateNewZip

' DateTime  : 03.08.2014 21:55

' Author    : The_Prist(Щербаков Дмитрий)

'             http://www.excel-vba.ru

' Purpose   : Основная процедура создания пустого ZIP-архива

'---------------------------------------------------------------------------------------

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


Данная процедура создает пустой ZIP-архив, в который далее и помещаются необходимые файлы. Эту процедуру необходимо обязательно копировать вместе с процедурами создания ZIP-архивов, приведенными ниже(Zip_File_Or_Files, Zip_All_Files_in_Folder, Zip_ActiveWorkbook).




АРХИВАЦИЯ ВЫБРАННЫХ ФАЙЛОВ
 


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

'---------------------------------------------------------------------------------------

' Procedure : Zip_File_Or_Files

' DateTime  : 03.08.2014 21:54

' Author    : The_Prist(Щербаков Дмитрий)

'             http://www.excel-vba.ru

' Purpose   : Архивация выбранных файлов

'---------------------------------------------------------------------------------------

Sub Zip_File_Or_Files()

    Dim sDate As String, sZIPPath As String, sZIPFileName As String, sWBName As String

    Dim objShell As Object, lf As Long, lZIPCnt As Long

    Dim avFiles

 

    'Выбираем файл/файлы, которые необходимо поместить в архив

    'чтобы выбирать не только файлы Excel:"All Files (*.*), *.*"

    avFiles = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*", , "Выбрать файлы для архивации", , True)

    If VarType(avFiles) = vbBoolean Then Exit Sub

    'создаем путь для создания архива(папка с выбранными файлами)

    sZIPPath = Replace(avFiles(1), Dir(avFiles(1), 16), "")

    If Right(sZIPPath, 1) <> "\" Then

        sZIPPath = sZIPPath & "\"

    End If

 

    sDate = Format(Now, " dd-mm-yy h-mm-ss")

    sZIPFileName = sZIPPath & "VBAZip " & sDate & ".zip"

    'создаем пустой ZIP-архив

    CreateNewZip (sZIPFileName)

    Set objShell = CreateObject("Shell.Application")

    lZIPCnt = 0

    For lf = LBound(avFiles) To UBound(avFiles)

        sWBName = Dir(avFiles(lf), 16)

        If IsBookOpen(sWBName) Then

            MsgBox "Невозможно поместить книгу '" & avFiles(lf) & "' в архив!" & vbNewLine & _

                   "Закройте книгу и повторите попытку."

        Else

            'помещаем файл в архив

            lZIPCnt = lZIPCnt + 1

            objShell.Namespace((sZIPFileName)).CopyHere CStr(avFiles(lf))

            'дожидаемся окончания архивации(особенно актуально для больших файлов)

            Do Until objShell.Namespace((sZIPFileName)).Items.Count = lZIPCnt

                DoEvents

            Loop

        End If

    Next lf

    If lZIPCnt Then

        MsgBox "Архив создан по пути: " & sZIPFileName, vbInformation, "www.excel-vba.ru"

    End If

End Sub

'---------------------------------------------------------------------------------------

' Procedure : IsBookOpen

' Purpose   : функция проверяет, отрыта ли книга в данный момент.

'             Если открыта - её невозможно поместить в архив

'             http://www.excel-vba.ru/chto-umeet-excel/kak-proverit-otkryta-li-kniga/

'---------------------------------------------------------------------------------------

Function IsBookOpen(wbName As String) As Boolean

    Dim wbBook As Workbook: On Error Resume Next

    Set wbBook = Workbooks(wbName)

    IsBookOpen = Not wbBook Is Nothing

End Function




СОЗДАНИЕ 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

'---------------------------------------------------------------------------------------

' Procedure : Zip_All_Files_in_Folder

' DateTime  : 03.08.2014 21:53

' Author    : The_Prist(Щербаков Дмитрий)

'             http://www.excel-vba.ru

' Purpose   : Создание архива из всех файлов в указанной папке

'---------------------------------------------------------------------------------------

Sub Zip_All_Files_in_Folder()

    Dim sFolderName As String, oFolder As Object

    Dim sDate As String, sZIPPath As String, sZIPFileName As String

    Dim objShell As Object

 

    sZIPPath = Application.DefaultFilePath

    If Right(sZIPPath, 1) <> "\" Then

        sZIPPath = sZIPPath & "\"

    End If

 

    sDate = Format(Now, " dd-mm-yy h-mm-ss")

    sZIPFileName = sZIPPath & "VBAZip " & sDate & ".zip"

 

    Set objShell = CreateObject("Shell.Application")

    'Выбираем папку

    With Application.FileDialog(msoFileDialogFolderPicker)

        If .Show = False Then Exit Sub

        sFolderName = .SelectedItems(1)

    End With

    'создаем пустой ZIP-архив

    CreateNewZip (sZIPFileName)

    If Right(sFolderName, 1) <> "\" Then

        sFolderName = sFolderName & "\"

    End If

    'помещаем файлы из папки в архив

    objShell.Namespace((sZIPFileName)).CopyHere objShell.Namespace((sFolderName)).Items

    'дожидаемся окончания архивации

    Do Until objShell.Namespace((sZIPFileName)).Items.Count = objShell.Namespace((sFolderName)).Items.Count

        DoEvents

    Loop

    MsgBox "Архив создан по пути: " & sZIPFileName, vbInformation, "www.excel-vba.ru"

End Sub




СОЗДАНИЕ 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

'---------------------------------------------------------------------------------------

' Procedure : Zip_ActiveWorkbook

' DateTime  : 03.08.2014 21:54

' Author    : The_Prist(Щербаков Дмитрий)

'             http://www.excel-vba.ru

' Purpose   : Создание архива с резервной копией активной книги

'---------------------------------------------------------------------------------------

Sub Zip_ActiveWorkbook()

    Dim sDate As String, sZIPPath As String

    Dim sZIPFileName, sBackupFileName

    Dim objShell As Object

    Dim sEx As String, lp As Long

 

    sZIPPath = Environ("TEMP")    'путь по умолчанию к папке временных файлов

    'можно указать любой, например

    'sZIPPath = "C:\temp" 'путь должен существовать

    If Right(sZIPPath, 1) <> "\" Then

        sZIPPath = sZIPPath & "\"

    End If

    'получаем расширение активной книги

    lp = InStrRev(ActiveWorkbook.Name, ".")

    If lp > 0 Then

        sEx = Mid(ActiveWorkbook.Name, lp)

    End If

 

    If Not sEx Like ".xl*" Then

        MsgBox "Неизвестный формат активной книги", vbInformation, "www.excel-vba.ru"

        Exit Sub

    End If

 

    sDate = Format(Now, " yyyy-mm-dd h-mm-ss")

    'имя архива

    sZIPFileName = sZIPPath & Left(ActiveWorkbook.Name, _

                                   Len(ActiveWorkbook.Name) - Len(sEx)) & sDate & ".zip"

    'имя временного файла

    sBackupFileName = sZIPPath & Left(ActiveWorkbook.Name, _

                                      Len(ActiveWorkbook.Name) - Len(sEx)) & sDate & sEx

    'если файла архива и такой же книги еще нет в папке

    If Dir(sZIPFileName) = "" And Dir(sBackupFileName) = "" Then

        'создаем копию активной книги

        'т.к. открытую книгу нельзя поместить в архив

        ActiveWorkbook.SaveCopyAs sBackupFileName

        'создаем пустой ZIP-архив

        CreateNewZip (sZIPFileName)

        'помещаем файл в архив

        Set objShell = CreateObject("Shell.Application")

        objShell.Namespace((sZIPFileName)).CopyHere sBackupFileName

        'дожидаемся окончания архивации

        Do Until objShell.Namespace((sZIPFileName)).Items.Count = 1

            DoEvents

        Loop

        'удаляем временный файл

        Kill sBackupFileName

        MsgBox "Резервная копия книги создана по пути: " & sZIPFileName, vbInformation, "www.excel-vba.ru"

    Else

        MsgBox "Невозможно создать архив, т.к. такая книга или архив уже присутствуют в папке", vbInformation, "www.excel-vba.ru"

    End If

End Sub




ИЗВЛЕЧЕНИЕ ИЗ ZIP-АРХИВА КОНКРЕТНОГО ФАЙЛА
 


1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

'---------------------------------------------------------------------------------------

' Procedure : ExtractFileFromZip

' DateTime  : 03.08.2014 22:02

' Author    : The_Prist(Щербаков Дмитрий)

'             http://www.excel-vba.ru

' Purpose   : Извлечение из архива конкретного файла

'---------------------------------------------------------------------------------------

Sub ExtractFileFromZip()

'C:\Documents            - папка для извлечения файла из архива

'C:\Documents\VBAZip.zip - имя ZIP-архива, из которого необходимо извлечь файл

'Книга1.xls              - имя файла в ZIP-архиве, который необходимо извлечь

    With CreateObject("Shell.Application").Namespace(("C:\Documents"))

        .CopyHere "C:\Documents\VBAZip.zip" & "\" & "Книга1.xls"

    End With

End Sub




ИЗВЛЕЧЕНИЕ ВСЕХ ФАЙЛОВ ИЗ ZIP-АРХИВА
 


1

2

3

4

5

6

7

8

9

10

11

12

13

14

'---------------------------------------------------------------------------------------

' Procedure : ExtractFromZipToFolder

' DateTime  : 03.08.2014 21:55

' Author    : The_Prist(Щербаков Дмитрий)

'             http://www.excel-vba.ru

' Purpose   : Извлечение всех файлов из архива

'---------------------------------------------------------------------------------------

Sub ExtractAllFilesFromZip()

'"C:\Documents"            - папка для извлечения файлов из архива

'"C:\Documents\VBAZip.zip" - имя ZIP-архива, из которого необходимо извлечь файлы

    With CreateObject("Shell.Application")

        .Namespace(("C:\Documents")).CopyHere .Namespace(("C:\Documents\VBAZip.zip")).Items

    End With

End Sub

 

Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования