vba - 爬行 Zip 文件

Question

我正在尝试爬行某个驱动器并从埋藏在子目录中的某些 .xls 文件中获取数据。该驱动器超过 1 TB，并且文件夹并不都具有相同的层次结构，因此我正在遍历所有文件夹。到目前为止，该脚本运行良好。

问题是，驱动器中有压缩文件。至少一半的文件是压缩格式的。我怎样才能抓取这些文件？

这是我的代码中爬行子目录的部分。还有另一个函数“TrailingSlash”，它只是在字符串中附加一个“\”(如果字符串还没有)。我在评论中赞扬了作者。

Public Function recursiveDir(colFiles As Collection, strFolder As String, strFileSpec As String, bIncludeSubfolders As Boolean) as Collection

    'From Ammara.com/access_image_faq/recursive_folder_search.html
    'Recursive function to search document tree from specific file extension

    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant
    Dim colFiles As New Collection
    Dim counter As Integer

    'Add files in strFolder matching strFileSpec to colFiles
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)

    On Error Resume Next
    Do While strTemp <> vbNullString
        colFiles.Add (strFolder & strTemp)
        counter = counter + 1
        Debug.Print ("files found: " & counter)
        strTemp = Dir
    Loop

    If bIncludeSubfolders Then
        'Fill colFolders with list of subdirectories of strFolder
        strTemp = Dir(strFolder, vbDirectory)
        Do While strTemp <> vbNullString
            If (strTemp <> ".") And (strTemp <> "..") Then
                If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
                    colFolders.Add strTemp
                End If
            End If
            strTemp = Dir
        Loop

        'Call recursiveDir for each subfolder in colFolders
        For Each vFolderName In colFolders
            Call recursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True)
        Next vFolderName
    End If

recursiveDir = colFiles

End Function

该函数将所有路径字符串添加到集合“colFolders”中，然后我用它来打开并从中提取数据。我现在认为可能没有一种简单的方法来返回压缩文件夹中文件的字符串路径。当该函数遇到 zip 时，可能需要调用一个单独的函数，该函数依次遍历压缩文件夹并将特定文件提取到本地目的地(只要我不必提取整个文件夹，我们应该表现得很好)。

我有点迷失自己应该做什么。谷歌搜索让我倾向于使用 shell.Application。我对 shell 一无所知，这是我应该走的路吗？

非常感谢 - 你们都很棒!

Answer 1

尝试使用此代码来搜索子文件夹:

Sub SO()

Dim x, i

x = GetFiles("C:\Users\SO\Folder", "*.xls*", True) '// x becomes an array of files found

For Each i In x
   Debug.Print i
Next i

End Sub

'-------------------------------------------------

Function GetFiles(StartPath As String, FileType As String, SubFolders As Boolean) As Variant

StartPath = StartPath & IIf(Right(StartPath, 1) = "\", vbNullString, "\") 'Sanity check

GetFiles = Split(Join(Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & StartPath & FileType & """ " & _
   IIf(SubFolders, "/S", vbNullString) & " /B /A:-D").StdOut.ReadAll, vbCrLf), ":"), "#"), "#")

End Function

但是对于 zip 文件，除了 CreateObject("Shell.Application").Namespace(zipName).Items 方法之外，Windows 本身并没有任何其他方法可以让您执行此操作.

我更喜欢使用 7-zip，它是免费、开源的，并且具有出色的命令行实用程序，这意味着您也可以使用 CreateObject("WScript.Shell") 通过 VBA 访问它方法(如上)