Deleting some specific files from a Zip using VBA

user_5720144 0
Viewed 1149

During a complete macro process I am creating a Zip file of a Folder. That folder have multiple sub-folders and files. Using This code:

    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

Now What i need to is to check that the Zip is less than 20mb, so that it can be sent via mail. Which I found can be done using line:

FileLen(path)

Now if the file size exceeds 20mb, i want to delete all the files from one specific subfolder of that Zip. I don't have any idea how to do that. Should I just create another zip like the original and try skipping files in that subfolder or there is some way to delete specific files in a Zip ?

I was trying to look inside the Zip using:

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

Still not able to get inside the Subfolders of the Zip.

vba excel
2 Answers

To delete a file from a zip file, try this. I am demonstrating on how to delete one file. Feel free to amend it to suit your needs

Logic:

  1. Use .MoveHere to move the file to user's temp directory. This will remove the file from the zip file
  2. Delete the file from the temp directory

Code: (Tried and Tested)

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

Alternative

  1. Add all relevant files to the zip
  2. After that in a loop check the file size and if it is within acceptable limits, add optional files one by one.
user_11405790

Using the Hints from above answer by Siddharth. This little piece of code worked.

Fortunately you can pass path of a folder inside the Zip to NameSpace directly and loop through it's files.

Using path as C:\-----\Test.Zip\Folder\Folder

So this worked Beautifully.

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
user_57201440
Related