Deleting a Folder from a Zip file

Question

I am trying to Delete a Folder from the Zip file.

So My file structure is like:

Inside First:

Answer 1

I managed to get TinMan's original idea to work by setting a WinAPI Timer to click yes in the confirmation dialog. API and TimerProc declarations are for VBA7 onwards.

Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, _
                                                         ByVal nIDEvent As LongPtr) As Long

Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, _
                                                        ByVal nIDEvent As LongPtr, _
                                                        ByVal uElapse As Long, _
                                                        ByVal lpTimerFunc As LongPtr) As LongPtr

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

' Delete the specified sub folder from a Zip file.
' Example:
' Call DeleteZipSubFolder("E:\first.zip\first\second")
Sub DeleteZipSubFolder(PathToZipFolder)
  Dim oShell As Object ' Reference: Microsoft Shell Controls And Automation
  
  On Error Resume Next
  
  Set oShell = CreateObject("Shell.Application")
  
  TimerID = SetTimer(0, 0, 100, AddressOf TimerProc)
  
  oShell.NameSpace(PathToZipFolder).Self.InvokeVerb "Delete"
  
  KillTimer 0, TimerID
  
  Set oShell = Nothing
  
  On Error Goto 0
End Sub

Public Sub TimerProc(ByVal hwnd As LongPtr, _
                     ByVal wMsg As Long, _
                     ByVal idEvent As LongPtr, _
                     ByVal dwTime As Long)
                         
  ' Wait for the Shell confirmation dialog to appear
  Sleep 100
  ' Use the Alt+Y shortcut to click the Yes button
  SendKeys "%Y"
  
End Sub

Answer 2

I was able to delete the folder.

CreateObject("Shell.Application").Namespace("C:\Users\mohit.bansal\Desktop\Test\test\first.zip\first\second").Self.Verbs.Item(4).DoIt

As GSerb pointed out it may be better to use InvokeVerb)"Delete" to delete the folder.

 CreateObject("Shell.Application").Namespace("C:\Users\mohit.bansal\Desktop\Test\test\first.zip\first\second").Self.InvokeVerb ("Delete")

I have not been able to suppress the file deletion conformation dialog.

---

So using .Self.Verbs.Item(4) we can access the Right Click Options starting with 0.

Demo:

Addendum

My final working solution was to copy the contents of the Xip file to a temp folder, delete the sub folder, delete the original zip file, create a new zip file, and copy the remaining items to the new zip file.

Usage:

  DeleteZipSubDirectory "E:\first.zip","\first\second"   

Sub DeleteZipSubDirectory(ZipFile As Variant, SubFolderRelativePath As Variant)
    Dim tempPath As Variant

    'Make Temporary Folder
    tempPath = Environ("Temp") & "\"
    Do While Len(Dir(tempPath, vbDirectory)) > 0
        tempPath = tempPath & "0"
    Loop
    MkDir tempPath

    Dim control As Object
    Set control = CreateObject("Shell.Application")
    'Copy Zip Contents to Temporary Folder
    control.Namespace(tempPath).CopyHere control.Namespace(ZipFile).Items

    'Debug.Print tempPath

    With CreateObject("Scripting.FileSystemObject")
        'Delete Target Folder
        .DeleteFolder tempPath & SubFolderRelativePath
        'Delete Original FIle
        Kill ZipFile

        'First we create an empty zip file: https://www.exceltrainingvideos.com/zip-files-using-vba/
        Open ZipFile For Output As #1
        Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
        Close #1

        'Copy the Remaining Items into the new Zip File
        control.Namespace(ZipFile).CopyHere control.Namespace(tempPath).Items
        Application.Wait Now + TimeValue("0:00:02")
        'Delete Temporary Folder
        .DeleteFolder tempPath
    End With
End Sub

Thanks for the Mikku and SiddharthRout for there help.