Удаление некоторых конкретных файлов из Zip с использованием VBA

Question

Во время полного процесса макроса я создаю Zip файл Folder.В этой папке есть несколько подпапок и файлов .Используя этот код:

    Dim oApp As Object
    NewZip (s_path & "\" & acc_name & ".zip")
    Set oApp = CreateObject("Shell.Application")
    oApp.Namespace(s_path & "\" & acc_name & ".zip").CopyHere oApp.Namespace(s_path & "\" & acc_name & "\").items

        On Error Resume Next
        Do Until oApp.Namespace(s_path & "\" & acc_name & ".zip").items.Count = _
        oApp.Namespace(s_path & "\" & acc_name & "\").items.Count
        Application.Wait (Now + TimeValue("0:00:01"))
        Loop
        On Error GoTo 0

    Set oApp = Nothing

Теперь мне нужно убедиться, что Zip меньше 20 МБ , чтобы его можно было отправить по почте.То, что я нашел, можно сделать с помощью строки:

FileLen(path)

Теперь, если размер файла превышает 20 МБ , я хочу удалить все файлы из одного конкретного подпапка этого почтового индекса.Я понятия не имею, как это сделать.Должен ли я просто создать другой zip-файл, такой как оригинал, и попробовать пропустить файлы в этой подпапке, или есть какой-то способ удалить определенные файлы в Zip-файле?

---

Я пытался заглянуть внутрь Zip, используя:

Dim FSO As Object

Dim sh As Object, fld As Object, n As Object

Set FSO = CreateObject("Scripting.FileSystemObject")


Set sh = CreateObject("Shell.Application")
Set ZipFile = sh.Namespace("C:\Users\mohit.bansal\Desktop\Test\Test.zip")

For Each fileInZip In ZipFile.Items
        Debug.Print (fileInZip)
Next

Все еще не может проникнуть внутрь подпапок почтового индекса.

Answer 1

Чтобы удалить файл из zip-файла, попробуйте это.Я демонстрирую, как удалить один файл.Не стесняйтесь вносить изменения в соответствии с вашими потребностями

Логика:

1. Используйте .MoveHere, чтобы переместить файл во временный каталог пользователя.Это удалит файл из zip-файла
2. Удалите файл из временного каталога

Код: (проверено и протестировано)

Option Explicit

Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Const MAX_PATH As Long = 260

Sub Sample()
    Dim zipFile, oShellApp, fileToDelete, fl

    zipFile = "C:\Users\routs\Desktop\Desktop.zip"
    fileToDelete = "Tester.xlsm"

    Set oShellApp = CreateObject("Shell.Application")

    For Each fl In oShellApp.Namespace(zipFile).Items
        If fl.Name = fileToDelete Then
            oShellApp.Namespace(TempPath).MoveHere (fl)
        End If
    Next fl

    Kill TempPath & fileToDelete
End Sub

'~~> Function to get the user's temp path
Function TempPath() As Variant
    TempPath = String$(MAX_PATH, Chr$(0))
    GetTempPath MAX_PATH, TempPath
    TempPath = Replace(TempPath, Chr$(0), "")
End Function

Альтернатива

1. Добавить все соответствующие файлы в zip
2. После этого в цикле проверьте размер файла и, если он находится в допустимых пределах, добавьтедополнительные файлы один за другим.

Answer 2

Используя подсказки сверху, ответьте Сиддхартом.Этот маленький кусочек кода сработал.

К счастью, вы можете передать путь к папке внутри Zip-файла непосредственно в NameSpace и перебрать его файлы.

Используя путь какC:\-----\Test.Zip\Folder\Folder

Так что это прекрасно работает.

Dim oApp As Object
Dim fl As Object
Set oApp = CreateObject("Shell.Application")

    For Each fl In oApp.Namespace("C:\Users\mohit.bansal\Desktop\Test\Test.zip\Test\Password Removed Files").items 
    'Path to a folder inside the Zip
        oApp.Namespace("C:\Users\mohit.bansal\Desktop\Test\abc\").MoveHere (fl.Path)
    Next