Question

我已经学习VBA大约六个月了，而我一直困扰着我数天，以为我认为这是一个简单的问题……这是一个简单的问题，我只是没有无法找到正确的解决方案。

我的项目涉及从网站下载大量文件夹，将其全部压缩，然后处理其中包含的数据以使其可用。现在，所有处理方面都已解决，但解压缩文件夹会占用大量时间，我认为使用另一个宏很容易解决。但是，我发现的所有宏都需要往返的特定路径，而我需要的东西将解压缩指定文件夹中的所有文件夹-同时使它们按文件夹名称进行组织。他们可以解压缩到同一文件夹，甚至可以覆盖zip文件（在这种情况下没有关系），但是必须按文件夹名称进行整理-否则处理部分将无效。

我一直在尝试修改以下代码以实现我的目的，但仍然存在两个问题：一个-我必须选择所有文件夹（以获取路径），而不仅仅是解压缩所有文件夹（我ve尝试修改以遍历每个子文件夹，但没有路径就看不到压缩文件夹，这与Dir（）一样。还有两个-它会将所有解压缩的文件转储到一个目标位置，从而使它无法进行处理。

一个简单的宏，与右键单击相同，“全部提取”，但循环遍历一个文件夹中的所有文件夹，将是完美的-但我还没有找到一个可行的宏。任何帮助或建议，将不胜感激。

这是我一直在尝试修改的代码：

Sub Button11_Click()

    Dim IPath, OPath As String, FFile, FFSo, FFolder As Object
    Dim oApp As Object
    Dim Fname As Variant
    Dim Output_Folder As Variant
    Dim strDate As String
    Dim i As Long

    IPath = "E:\R2\Input\Zipped\"
    OPath = "E:\R2\Input\"

    'Select multiple zip files to unzip
    MsgBox "Go to E:\R2\Input\Zipped\ - For Zipped folders"
    Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
                                        MultiSelect:=True)

    If IsArray(Fname) = False Then
        'Do nothing
    Else

        'For Each SFolder In AFolder.Subfolders

        'Set output folder path for unzip files
        Output_Folder = OPath

        'Extract the files into output folder
        Set oApp = CreateObject("Shell.Application")

        For i = LBound(Fname) To UBound(Fname)

            'WORKS BUT DOESN"T SEPARATE INTO FOLDERS, just dumps into input folder.
            oApp.Namespace(Output_Folder).CopyHere oApp.Namespace(Fname(i)).items

        Next i

        MsgBox "You find the files here: " & Output_Folder

    End If

End Sub

Answer 1

因此，由于没有其他人提供帮助，我自己解决了这个问题。

在Output_Folder = Mkdir OPath & "\" & Fname(i)行中，cronos2546的答案有问题。这是无效的语法。

您首先需要做的是Mkdir OPath & "\" i一行。然后，您将要进行分配Output_Folder = OPath & "\" & i。您无法在试图分配目录（字符串）的同一行中建立目录。此外，Fname（i）是一条完整的路径，它将给您带来问题。我建议像本段开头一样将Fname(i)更改为i。这只会为您的文件夹编号。

最后，@ JMP883出现路径错误，因为zip文件输出在输出路径中已经有一个具有相同名称的文件夹。在每次尝试运行宏之前，请确保删除或移动输出路径中的所有内容。

Answer 2

我认为这就是您要寻找的。基本上，每次循环浏览文件名时，您都会创建目录。

Else

    'For Each SFolder In AFolder.Subfolders

    'Set output folder path for unzip files
    'Output_Folder = OPath

    'Extract the files into output folder
    Set oApp = CreateObject("Shell.Application")

    For i = LBound(Fname) To UBound(Fname)
        'V Might need to update to "correct" name
        Output_Folder = Mkdir OPath & "\" & Fname(i)
        'WORKS BUT DOESN"T SEPARATE INTO FOLDERS, just dumps into input folder.
        oApp.Namespace(Output_Folder).CopyHere oApp.Namespace(Fname(i)).items

    Next i

    MsgBox "You find the files here: " & Output_Folder

End If

Excel VBA-将多个文件夹解压缩到多个文件夹

2 个答案: