使用 VBA 遍历 zip 文件 [英] Traverse zip file using VBA

问题描述

我需要使用 VBA 遍历 zip 文件.特别是我需要在不解压缩文件的情况下找到 xl 文件夹以找到 media 子文件夹.然后我需要将图像从媒体子文件夹中复制出来并将它们保存到另一个文件夹中.

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

^该代码成功地遍历了文件夹并收集了 zip 文件的名称.但是我需要进入文件并遍历结构才能到达 Media 文件夹.

^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.

推荐答案

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

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

- 这显示了如何将提取合并到您的代码中.只需将完整的 zip 路径和位置传递到您要提取文件的位置.您可以在现有循环中执行此操作.

- 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

这篇关于使用 VBA 遍历 zip 文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！