VBA и архиватор WinZip

[devel]

Добрый день!

Подскажите дилетанту. Есть файл на компе. Есть установленный на компе архиватор WinZip. Требуется на VBA написать команду, чтобы заархивировать этот файл WinZip - ом. Как это сделать?

[Денис]

Код: Выделить всё

dim FilePath as string
dim WinZip as string

const AddTo as string = " /a "

Filepath= "c:\temp\file.doc"
winzip = "c:\progra~1\winzip\winzip.exe"

Shell WinZip & AddTo & FilePath, vbHide


Пути и имена свои подставите.
А вообще, код писал на лету, так что консольные команды посмотрите в справке к winzip'у.

[KL]

http://www.rondebruin.nl/windowsxpzip.htm
http://www.rondebruin.nl/zip.htm
http://www.rondebruin.nl/7zipwithexcel.htm

[Gurren]

А для WinRar - а что нить подобное есть?
Дайте кодик если не сложно

[ger_kar]

Команда A — добавить в архив
Добавляет в архив указанные файлы и папки. Эта команда является эквивалентом командной строки команды "Добавить".
Примеры:

а) Добавить все файлы *.hlp из текущей папки в архив help.rar :
WinRAR a help *.hlp

б) Заархивировать все файлы из текущей и вложенных папок в самораспаковывающийся непрерывный архив, разделённый на тома save.part1.exe, save.part2.rar, save.part3.rar, … размером по 362000 байт, и добавить к каждому тому информацию для восстановления:
WinRAR a -r -v362 -s -sfx -rr save

Так как имена обрабатываемых файлов не указаны, подразумеваются все файлы (*.*).

в) Если в качестве аргумента указано имя папки, то в архив будет добавлено все содержимое указанной папки (и вложенных папок, если указан ключ -r). Следующая команда добавит все файлы из папки Bitmaps в RAR-архив Pictures:

WinRAR a -r Pictures.rar Bitmaps
Конечно, можно использовать и обычный формат и ввести Bitmaps\*.*, а не Bitmaps.

Взято из справки WinRaR, если на компьютере есть установленный WinRaR, смотри справку по режиму командной строки,
а как использовать эти команды в коде тебе Денис выше написал. Только смотри внимательно для зипа от указал /а а здесь просто а

[Gurren]

Все, спасибо большое) а я то думаю... че за "/а"

а не имеет значения в какой последовательности использовать консольные команды?
Ну например можно написать x = "a -r -s", а можно x = "-s -r a"

[Gurren]

что то не совсем получилось... может я не так что то понял?
Посмотрите пожалуйста кодик...
Показывает ошибку WinRar "не найден путь к файлу". я через With посмотрел... путь то верен... а с какого кхе-кхе не правельно?

Код: Выделить всё

Private Sub Кнопка30_Click()
Dim ПутьКФайлу As String
Dim ПутьКФинРару As String

Const КонсольныеКоманды As String = " a "

ПутьКФайлу = CurrentProject.Path & "\БД.mdb"
ПутьКФинРару = "C:\Program Files\WinRAR\winrar.exe"

Shell ПутьКФинРару & КонсольныеКоманды & ПутьКФайлу, vbHide
End Sub

[ger_kar]

Код: Выделить всё

Private Sub Кнопка30_Click()
     Dim ПутьКФайлу As String
     Dim ПутьКФинРару As String
     Const КонсольныеКоманды As String = " a  База "
     ПутьКФайлу = Chr$(34) & CurrentProject.Path & "\БД.mdb" & Chr$(34)
     ПутьКФинРару = Chr$(34) & "C:\Program Files\WinRAR\winrar.exe" & Chr$(34)
     Shell ПутьКФинРару & КонсольныеКоманды & ПутьКФайлу, vbHide
End Sub

[Gurren]

в место "база" можно указать путь, куда архив кидать winrar-у надо?
типо того: Const КонсольныеКоманды As String = " a c:\база "
только что бы с CurrentProject.Path работало... а то я попробовал, фиг там

[ger_kar]

База - а это что? Тоже команда такая?

База - это имя твоей базы, в таком виде создаст архив в текущей рабочей директории,
если указать (путь + имя) то создаст соответственно в этом месте.

а) Добавить все файлы *.hlp из текущей папки в архив help.rar :
WinRAR a help *.hlp

Справку надо читать внимательно.

[Gurren]

CurrentProject.Path как с именем архива совместить?
транскрипция не правильная у меня получается(
Прописать то путь не проблема, а вот как с CurrentProject.Path совместить, что бы winrar например сохранял - CurrentProject.Path & "\АрхивнаяКопия\База"

[Diamock]

Если требуется обычный zip-архив, можно использовать средства Windows.

[Gurren]

спасибо, но мне нужно архивацию сделать программным способом...

[Diamock]

:) спасибо, но мне нужно архивацию сделать программным способом...

И я о том же.
Программно, но используя средства Windows.
Процедура создания ZIP-архива:

Код: Выделить всё

Public Sub CreateZIP(ByVal ZIPFileName As String)
    Dim ff As Long
    Dim ShellApp As Object
    ff = FreeFile
    Set ShellApp = CreateObject("Shell.Application")
    Open ZIPFileName For Output As #ff
    Print #ff, Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, vbNullChar);
    Close #ff
End Sub

Пример программного создания пустого ZIP-архива.

[ger_kar]

CurrentProject.Path как с именем архива совместить? транскрипция не правильная у меня получается(Прописать то путь не проблема, а вот как с CurrentProject.Path совместить, что бы winrar например сохранял - CurrentProject.Path & "\АрхивнаяКопия\База"

Ну так и совместить CurrentProject.Path & "\АрхивнаяКопия\База", но если в пути будут пробелы, то так работать не будет, для того
чтобы путь с пробелами воспринимался правильно его нужно заключить в кавычки.
Примерно так:

Код: Выделить всё

ПутьКАрхиву = Chr$(34) & CurrentProject.Path & "\АрхивнаяКопия\База.rar" & Chr$(34)

При этом папка "Архивная копия" должна существовать иначе возникнет ошибка.
Я бы сделал так:

Код: Выделить всё

Private Sub Кнопка30_Click()
    Dim ПутьКФайлу As String
    Dim ПутьКФинРару As String
    Const КонсольныеКоманды As String = "a -ep -ag_YYYY-MM-DD-[NN]"
    ПутьКФайлу = Chr$(34) & CurrentProject.Path & "\БД.mdb" & Chr$(34)
    ПутьКФинРару = Chr$(34) & "C:\Program Files\WinRAR\winrar.exe" & Chr$(34)
    ПутьКАрхиву = Chr$(34) & CurrentProject.Path & "\АрхивнаяКопия\База.rar" & Chr$(34)
    Shell ПутьКФинРару & " " & КонсольныеКоманды & " " & ПутьКАрхиву & " " & ПутьКФайлу, vbHide
End Sub

Тебе остается в эту процедуру перед созданием архива добавить проверку на существование папки и если она не существует то создать ее

[ger_kar]

Процедура создания ZIP-архива:

Код: Выделить всё

Public Sub CreateZIP(ByVal ZIPFileName As String)
    Dim ff As Long
    Dim ShellApp As Object
    ff = FreeFile
    Set ShellApp = CreateObject("Shell.Application")
    Open ZIPFileName For Output As #ff
    Print #ff, Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, vbNullChar);
    Close #ff
End Sub

А смысл создавать ссылку на объект "Set ShellApp = CreateObject("Shell.Application")" и нигде по ходу процедуры его не использовать ?

[Gurren]

Спасибо большое)
Все получилось)

[Diamock]

А смысл создавать ссылку на объект "Set ShellApp = CreateObject("Shell.Application")" и нигде по ходу процедуры его не использовать ?

Каюсь, просмотрел , когда обрезал до функции
Код полностью выглядит так:

Код: Выделить всё

Option Explicit

'########################################################################################
Private Function FileExist(FileName As String) As Boolean
'########################################################################################
'# Функция проверки существования файла
'########################################################################################
'# Параметры функции:
'########################################################################################
'# FileName         - [Обязательный]
'#                  - Тип String
'#                  - Имя проверяемого файла. Если путь к файлу не указан, проверяется
'#                  - файл в текущем каталоге текущего диска
'########################################################################################
'# Возвращаемое значение
'#                  - Тип Boolean
'#                  - Если файл существует, возвращает True
'#                  - Если файл не существует, возвращает False
'#                  - В случае ошибки, возвращает False
'########################################################################################

On Error GoTo ErrFileExist              '# Включаем обработчик ошибок

If Dir$(FileName) = vbNullString Then   '# Проверяем файл
    FileExist = False                   '# Файл не существует, FileExist = False
Else
    FileExist = True                    '# Файл существует, FileExist = True
End If
Exit Function                           '# Выход из процедуры

ErrFileExist:                           '# Обработка ошибок
    FileExist = False                   '# Файл не существует, FileExist = False
End Function
'########################################################################################

'########################################################################################
Public Sub CreateZIP(ZIPFileName As String, Optional Overwrite As Boolean = True)
'########################################################################################
'# Процедура создания ZIP архива
'########################################################################################
'# Параметры процедуры:
'########################################################################################
'# ZIPFileName      - [Обязательный]
'#                  - Тип String
'#                  - Полный путь к архиву
'########################################################################################
'# Overwrite        - [Необязательный]
'#                  - Тип Boolean
'#                  - Указание на возможность записи на место существующего файла.
'#                  - В случае, когда значение равно True, такая запись разрешается;
'#                  - в противном случае значение равно False.
'#                  - Если параметр опущен, запись поверх существующего файла разрешена
'########################################################################################

'# Объявление переменных процедуры

Dim ff          As Long     '# Переменная на доступ к свободному каналу
Dim FE          As Boolean  '# Переменная для хранения валидности файла


    '# Инициализация переменных
   
    ff = FreeFile                                       '# Получаем свободный канал
    FE = FileExist(ZIPFileName)                         '# Проверка валидности [ZIPFileName]
   
    '# Обработка параметра [Overwrite]
   
    Select Case Overwrite                               '# Провека параметра [Overwrite]
        Case True                                       '# Перезапись разрешена
            If FE = True Then                           '# ZIP архив существует
                Kill ZIPFileName                        '# Удаляем ZIP архив
            End If
        Case False                                      '# Перезапись запрещена
            If FE = True Then                           '# ZIP архив существует
                MsgBox "ZIP архив " & _
                vbCrLf & ZIPFileName & _
                vbCrLf & "существует.", _
                vbInformation, App.Title                '# Выводим информационное сообщение
               
                Exit Sub                                '# Выходим из процедуры
            End If
    End Select                                          '# Окончание проверки [Overwrite]
   
    '# Создание ZIP файла
   
    Open ZIPFileName For Output As #ff                  '# Открываем файл для записи
        Print #ff, Chr(80) & Chr(75) & _
        Chr(5) & Chr(6) & String(18, vbNullChar);       '# Создаём ZIP файл
        '####################################################################
        '# ВНИАНИЕ!!!                                                       #
        '# Точка с запятой в конце строки обязательна, чтобы оператор Print #
        '# не добавлял в файл символ переноса vbCrLf                        #
        '####################################################################
    Close #ff                                           '# Закрываем канал
   
End Sub
'########################################################################################

'########################################################################################
Public Sub AddFFFromZIP(ByVal ZIPFileName As String, ByVal AddFFName As String)
'########################################################################################
'# Примечание к процедуре!
'########################################################################################
'# Изначально, планировалось создать две процедуры. Добавление файла в ZIP архив и добав-
'# ление папки в ZIP архив. Но структура кода в теле обеих процедур была одинакова, поэ-
'# тому я решил использовать одну процедуру для добавления фалов и папок.
'########################################################################################
'# Параметры процедуры:
'########################################################################################
'# ZIPFileName      - [Обязательный]
'#                  - Тип String
'#                  - Полный путь к архиву
'########################################################################################
'# AddFFName        - [Обязательный]
'#                  - Тип String
'#                  - Полный путь к добавляемому файлу или папке
'########################################################################################

Dim ShellApp    As Object   '# Переменная для инициализации [Shell.Application]
Dim ObjFolder   As Object   '# Переменная для папки копирования
   
    Set ShellApp = CreateObject("Shell.Application")    '# Инициализация [Shell.Application]
    Set ObjFolder = ShellApp.NameSpace((ZIPFileName))
    ObjFolder.CopyHere (AddFFName), 4
   
    '# Добавляем файл (папку) в ZIP архив
   
    Set ShellApp = Nothing      '# Освобождаем переменную
    Set ObjFolder = Nothing     '# Освобождаем переменную

End Sub