Как создать и сохранить несколько файлов в .zip

[Lubocka]

Надо в Excel 2003 имеющие 2-3 файла упаковать в zip-файл
как это сделать?
1) как создать файл.zip?
2) как всунуть в него мои 2-3 файла?
3) как потом его сохранить?

[0mega]

Все имеющиеся у Вас файлы поместите в одну папку.
Кликаем правой мышкой по этой папке. Выбираем " добавить в ахив " ( в компьютерах Macintosh - "Сжать") и отмечаем ZIP
После ZIPования Вашу папку можно отправлять по почте выкладывать на форумах и т.д.
По умолчанию все Windows компьютеры сжимают в формате RAR.
Но формат RAR не все компьютеры умеют раскрывать.
Не забывайте отмечать ZIP

[Serge_Bliznykov]

По умолчанию все Windows компьютеры сжимают в формате RAR.

глупости! То, что WinRAR стоит почти на каждом компьютере не делает его ни бесплатным, так же, как и не делает его входящим в состав Windows!
Нормальная Windows не умеет не только сжимать в формат RAR, но и даже распаковывать!!

[0mega]

Сообщение от Serge_Bliznykov

Нормальная Windows не умеет не только сжимать в формат RAR, но и даже распаковывать!!

Ув. Сергей.
Есть хорошая поговорка: " свет не только что в оконце, за окном еще больше"
Я не знаю какую Windows Вы называете нормальной, лично я имел в виду Macintosh.
Apple свои машины еще при "рождении" комплектуется встроенным ZIP-архиватором

[Lubocka]

извиняюсь, но я немного неправильно выразила свое пожелание, я хочу создать программным путем zip-файл, наподобии как это сделано в 1С 8.1
например:
ZipFile = Новый ЗаписьZipФайла(КаталогДанных +"\"+ИмяФайлаZip);
ZipFile.Добавить(КаталогДанных +"\"+ИмяФайла1);
ZipFile.Добавить(КаталогДанных +"\"+ИмяФайла2);
ZipFile.Записать();


хочу также только в Excel 2003 с помощью Visual Basic

[Pavel55]

http://www.rondebruin.nl/windowsxpzip.htm

Sub Zip_File_Or_Files()
    Dim strDate As String, DefPath As String, sFName As String
    Dim oApp As Object, iCtr As Long, i As Long
    Dim FName, vArr As Variant, FileNameZip As String

    'УКАЖИТЕ СВОЮ ПАПКУ, КУДА ПОМЕСТИТЬ АРХИВ ZIP
    DefPath = "C:\Temp\"

    'DefPath = Application.DefaultFilePath 'Мои документы
    If Right(DefPath, 1) <> "\" Then DefPath = DefPath & "\"

    'имя будущего архива
    strDate = Format(Now, " yy-mm-dd h-mm-ss")
    FileNameZip = DefPath & "Архив_" & strDate & ".zip"

    'Browse to the file(s), use the Ctrl key to select more files
    'выбираем файл(ы), используйте кнопку Ctrl, чтобы выбрать несколько файлов
    FName = Application.GetOpenFilename(filefilter:="Все файлы Microsoft Office Excel (*.xl*),*.xls,Все файлы(*.*),*.*", _
        MultiSelect:=True, Title:="Укажите файлы для архивации")
    
    If IsArray(FName) = False Then
        'do nothing
    Else
        'Create empty Zip File
        'создаём пустой Zip файл
        NewZip (FileNameZip)
        Set oApp = CreateObject("Shell.Application")
        For iCtr = LBound(FName) To UBound(FName)
            vArr = Split97(FName(iCtr), "\")
            sFName = vArr(UBound(vArr))
            If bIsBookOpen(sFName) Then
                MsgBox "Вы не можете заархивировать файл, который открыт!" & vbLf & _
                       "Пожалуйста закройте: " & FName(iCtr)
            Else
                'Copy the file to the compressed folder
                'копируем файл в сжатую папку
                i = i + 1
                oApp.Namespace((FileNameZip)).CopyHere FName(iCtr)
                'Keep script waiting until Compressing is done
                'специальная задержка, чтобы процесс архивации успел закочится
                On Error Resume Next
                Do Until oApp.Namespace((FileNameZip)).items.Count = i
                    DoEvents
                    'Application.Wait (Now + TimeValue("0:00:01"))
                Loop
                On Error GoTo 0
            
            End If
        Next iCtr
        MsgBox "Архив сохранён в: " & FileNameZip
    End If
    Set oApp = Nothing

End Sub

Sub NewZip(sPath)
'Create empty Zip File
    Dim oFSO As Object, arrHex(), sBin As String, i As Long
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    arrHex = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
    For i = 0 To UBound(arrHex)
        sBin = sBin & Chr(arrHex(i))
    Next
    With oFSO.CreateTextFile(sPath, True)
        .Write sBin
        .Close
    End With
End Sub

Function Split97(sStr As Variant, sdelim As String) As Variant
'Tom Ogilvy
    Split97 = Evaluate("{""" & Application.Substitute(sStr, sdelim, """,""") & """}")
End Function

Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
    On Error Resume Next
    bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

[Lubocka]

Спасибо. Ваша помощь мне очень помогла.
Все работает как я хотела

Ну просто ОГРОМНОЕ спасибо.

[88ra]

Добрый день! Подскажите, уважаемые!
Использовал вышеуказанный код, работает - если вручную выбирать файлы.
Если публикую массив FName, и записываю значения в другой процедуре, то не работает - ошибка 9 на:
oApp.Namespace((FileNameZip)).CopyH ere FName(iCtr)
ну а дальше по тексту, в бесконечный цикл впадает

[88ra]

проблема решилась добавлением пары скобок:

oApp.Namespace((FileNameZip)).CopyH ere (FName(iCtr))