CODEWITHSUNDEEP
excelzipvba
Anthony
Anthony

Reputation: 147

Traverse zip file using VBA

I need to traverse a zip files using VBA. In particular I need to, without unzipping the file, locate the xl folder in order to find the media subfolder. I then need to copy the images out of the media subfolder and save them to another folder. 

Public Sub Extract_Images()
Dim fso As FileSystemObject
Dim objFile As File
Dim myFolder
Const zipDir As String = "\\...\ZIP FILES"
Const xlFolder As String = "xl"
Const mediaFolder  As String = "media"
Dim picname As String
Dim zipname As String

Set fso = New FileSystemObject
Set myFolder = fso.GetFolder(zipDir)

For Each objFile In myFolder.Files
zipname = objFile.Name

Next objFile

End Sub

^That code successfully loops through the folder and gathers the names of the zip files. But I need to get into the files and traverse the structures to get to the Media folder.

Upvotes: 0

Views: 1695

Answers (1)

Tim Williams
Tim Williams

Reputation: 166885

Building off: https://www.rondebruin.nl/win/s7/win002.htm

Edit: - this shows how you can incorporate the extraction into your code. Just pass the full zip path and the location to where you want to extract the files. You can do this from within your existing loop.

You may need to account for media files sharing the same name if you're planning on extracting them all to the same location...

Sub Tester()

    ExtractMediaFiles "C:\Users\twilliams\Desktop\tempo.zip", _
                 "C:\Users\twilliams\Desktop\extracted\"

End Sub



Sub ExtractMediaFiles(zipFile As Variant, outFolder As Variant)

    Dim oApp As Object
    Dim fileNameInZip As Variant, oNS As Object

    Set oApp = CreateObject("Shell.Application")

    On Error Resume Next
    Set oNS = oApp.Namespace(zipFile & "\xl\media")
    On Error GoTo 0

    If Not oNS Is Nothing Then
        For Each fileNameInZip In oNS.items
            Debug.Print fileNameInZip
            oApp.Namespace(outFolder).copyhere oNS.items.Item(CStr(fileNameInZip))
        Next
    Else
        Debug.Print "No xl\media path for " & zipFile
    End If

End Sub

Upvotes: 3

Related Questions