获取文件夹和子文件夹中的所有文件

问题描述

我要执行以下操作：

1. 提示用户选择文件夹
2. 循环浏览文件夹（以及子文件夹，如果存在的话）
3. 获取所有.xlsx文件
4. 从这些文件中获取特定的列（所有文件都具有相同的结构），然后合并该列中的数据

我得到了所有子文件夹和所有文件，但是却得到了应有的五倍。

L列是我获取所有数据并插入相同的主文件的地方（插入L列）。
我有5个文件-我应该在最后一列中获得5个项目，只需在其中添加新文件夹和相同的文件（已复制），所以现在我应该在最后一列中获得10个项目，而不是50个。

<<

解决方法

您同时使用FSO和Dir（）遍历文件，所以这就是为什么要一遍又一遍地获取相同文件的原因。

当您的潜艇最终完成一堆事情时（尤其是当一个事物嵌套在另一个事物中，依此类推）时，最好考虑将其拆分，这样您就可以专注于一个给您带来麻烦的事物，而不会其他所有事情都“妨碍”。

这是一个精简版，以显示我的意思。它可以工作，但为清楚起见，没有您的文件处理代码。

Option Explicit

Sub LoopThroughFolder()

    Dim Wb As Workbook,sWb As Workbook
    Dim FolderPath As String
    Dim colFiles As Collection,f

    'get a folder
    FolderPath = ChooseFolder()
    If Len(FolderPath) = 0 Then
        MsgBox "No folder selected: exiting"
        Exit Sub
    End If
    
    'find all excel files in subfolders of that folder
    Set colFiles = FileMatches(FolderPath,"*.xlsx")
    If colFiles.Count = 0 Then
        MsgBox "No xlsx files found"
        Exit Sub
    End If
    
    Set Wb = ThisWorkbook
    Wb.Sheets(2).Range("L:L").ClearContents
    
    'loop over the files we found
    For Each f In colFiles
        Set sWb = Workbooks.Open(f.Path)
        'process the file here
        sWb.Close SaveChanges:=True
    Next f
    
End Sub

Function ChooseFolder() As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Choose a folder"
        .InitialFileName = "C:\Users\"
        .AllowMultiSelect = False
        If .Show = -1 Then
            ChooseFolder = .SelectedItems(1)
            If Right(ChooseFolder,1) <> "\" Then _
                       ChooseFolder = ChooseFolder + "\"
        End If
    End With
End Function

'Return a collection of file objects given a starting folder and a file pattern
'  e.g. "*.txt"
'Pass False for last parameter if don't want to check subfolders
Function FileMatches(startFolder As String,filePattern As String,_
                    Optional subFolders As Boolean = True) As Collection

    Dim fso,fldr,f,subFldr
    Dim colFiles As New Collection
    Dim colSub As New Collection
    
    Set fso = CreateObject("scripting.filesystemobject")
    colSub.Add startFolder
    
    Do While colSub.Count > 0
        Set fldr = fso.getfolder(colSub(1))
        colSub.Remove 1
        For Each f In fldr.Files 'get files in folder
            If UCase(f.Name) Like UCase(filePattern) Then colFiles.Add f
        Next f
        If subFolders Then 'get subfolders for processing?
            For Each subFldr In fldr.subFolders
                colSub.Add subFldr.Path
            Next subFldr
        End If
    Loop
    Set FileMatches = colFiles
End Function