excel - 使用 VBA 从 Zip 中删除某些特定文件

Question

这个问题已经有答案了:

How to delete files from zip with VBScript (1 个回答)

已关闭 4 年前。

在完整的宏过程中，我正在创建一个 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 是否小于20mb，以便可以通过邮件发送。我发现可以使用以下行来完成:

FileLen(path)

现在，如果文件大小超过20mb，我想删除该 Zip 的一个特定子文件夹中的所有文件。我不知道该怎么做。我应该像原始文件一样创建另一个 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

仍然无法进入 Zip 的子文件夹。

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. 之后，循环检查文件大小，如果在可接受的范围内，则逐个添加可选文件。