excel - 提取 zip 文件时出现错误 'run-time error -2147024894(80070002)' ...

Question

我有一个存档文件，其中包含多个子文件夹。

例如:C:\Documents and Settings\Owner\Desktop\Macro\Intermediación Financiera\2013\12\BCO_Ind.zip
在 BCO_Ind.zip 包含此子文件夹 scbm\2013\09\fileThatIWant.xls
这些子文件夹对于每个存档文件都是不同的，尽管它具有相同的名称。
事情是我想要最后一个子文件夹中的最后一个文件。

我从 http://excelexperts.com/unzip-files-using-vba 修改了代码来自 www.rondebruin.nl/win/s7/win002.htm

问题是我收到一个错误:run-time error -2147024894(80070002)': Method 'Namespace' of Object 'IShellDispatch4' failed .

我尝试从网站上搜索所有内容，但我几乎一周都没有找到解决方案。
这是代码:

Sub TestRun()
'Change this as per your requirement
Call unzip("C:\Documents and Settings\Owner\Desktop\Macro\Intermediación Financiera\2013\12\", "C:\Documents and Settings\Owner\Desktop\Macro\Intermediación Financiera\2013\12\BCO_Ind.zip")
End Sub

Public Function unzip(targetpath As String, filename As Variant, Optional SCinZip As String, _
                    Optional excelfile As String) As String '(targetpath As String, filename As Variant)

Dim strScBOOKzip As String, strScBOOK As String:  strScBOOK = targetpath 
Dim targetpathzip As String, excelpath As String 
Dim bzip As Boolean: bzip = False
Dim oApp As Object
Dim FileNameFolder As Variant
Dim fileNameInZip As Object
Dim objFSO As Scripting.FileSystemObject
Dim filenames As Variant: filenames = filename

If Right(targetpath, 1) <> Application.PathSeparator Then
   targetpathzip = targetpath & Application.PathSeparator
Else
   targetpathzip = targetpath
End If

FileNameFolder = targetpathzip
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set oApp = CreateObject("Shell.Application")
''-----i get an error in here
For Each fileNameInZip In oApp.Namespace(filenames).Items
  If objFSO.FolderExists(FileNameFolder & fileNameInZip) Then
    objFSO.DeleteFolder FileNameFolder & fileNameInZip, True: Sleep 1000
  End If
''-----i get an error in here too
  oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(filename).Items.item(CStr(fileNameInZip))
  bzip = True
Next fileNameInZip

If bzip Then
  excelpath = findexactfile(targetpath) ' this will go to the function that find the file from subfolders
Else
  excelpath = ""
End If
searchfolder = FileNameFolder & fileNameInZip

finish:
  unzip = excelpath
  Set objFSO = Nothing
  Set oApp = Nothing
End Function

我还在开发宏中勾选了一些工具>引用，但仍然出现相同的错误。我现在真的很紧张+沮丧。请帮我修复它。另外，是否有一个简单的代码作为我的引用，可以在提取文件后从子文件夹中查找文件？如果有人可以分享代码，我真的很感激。

Answer 1

我有一个 VBA 解决方案:

从所有 zip 文件所在的根文件夹中，提取 zip 文件中的所有文件，但不包含路径。

然后我对其进行了修改，以便将 zip 文件中具有最深路径的第一个文件提取到预定义的文件夹中。这应该符合您的情况。

Option Explicit

Const sEXT As String = "zip"
Const sSourceFDR As String = "C:\Debug" ' Folder that contains all the zip files
Const sTargetFDR As String = "C:\Test" ' Folder to store all the files within the zip

Dim oFSO As Object, oShell As Object
Dim oCopy As Object ' Comment out to extract all files without path

Sub StartUnzipAll()
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oShell = CreateObject("Shell.Application")
    Debug.Print Now & vbTab & "StartUnzipAll() Started"

    UnZipFolder sTargetFDR, sSourceFDR

    ' Only copy the first file in deepest folder:
    ' Comment out If-Block to extract all files without path
    If Not oCopy Is Nothing Then
        oShell.Namespace(sTargetFDR & Application.PathSeparator).CopyHere oCopy
    End If

    Debug.Print Now & vbTab & "StartUnzipAll() Finished"
    Set oShell = Nothing
    Set oFSO = Nothing
End Sub

Private Sub UnZipFolder(sTgtFDR As String, sSrcFDR As String)
    Dim oFile As Variant, oFDR As Variant
    ' Process all files in sSrcFDR
    For Each oFile In oFSO.GetFolder(sSrcFDR).Files
        If oFSO.GetExtensionName(oFile) = sEXT Then
            UnZipFile sTgtFDR, oFile.Path
        End If
    Next
    ' Recurse all sub folders in sSrcFDR
    For Each oFDR In oFSO.GetFolder(sSrcFDR).SubFolders
        UnZipFolder sTgtFDR, oFDR.Path
    Next
End Sub

Private Sub UnZipFile(sFDR As String, oFile As Variant)
    Dim oItem As Object
    For Each oItem In oShell.Namespace(oFile).Items
        ' Process files only (identified by "." in the name)
        If InStr(1, oItem.Name, ".", vbTextCompare) > 0 Then
            Debug.Print "File """ & oItem.Name & """ in """ & oItem.Path & """"
            ' Comment out If-Block to extract all files without path
            If oCopy Is Nothing Then
                Set oCopy = oItem
            Else
                If UBound(Split(oItem.Path, Application.PathSeparator)) > UBound(Split(oCopy.Path, Application.PathSeparator)) Then
                    Set oCopy = oItem
                End If
            End If
            ' Uncomment to extract all files without path
            'Debug.Print "Extracting """ & oIem.Name & """ to """ & sFDR & """"
            'oShell.Namespace(sFDR & Application.PathSeparator).CopyHere oItem
        Else
            ' No file extension, Recurse into this folder
            UnZipFile sFDR, oItem.Path
        End If
    Next
End Sub

希望这可以帮助你。圣诞快乐!