通过Zip文件进行爬网

时间:2015-01-08 19:10:56

标签: vba excel-vba automation zip excel

我试图抓取某个驱动器,并从隐藏在子目录中的某些.xls文件中获取数据。该驱动器已超过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

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

我有点迷失在我应该做的事情上。谷歌周围指向我使用shell.Application。我对贝壳一无所知,这是我应该走的路吗?

非常感谢 - 你们都很棒!

1 个答案:

答案 0 :(得分:0)

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

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访问它

相关问题