如何在VBA中设置条件仅提取指定文件夹内的.xlsx文件

Got it, let’s tweak your macro to hit both of your requirements—only grabbing .xlsx files, and limiting the "hoover test" folder to just one extracted file. Here’s the adjusted DoFolder subroutine with explanations:

Modified Macro Code #

Sub DoFolder(Folder)
    Dim SubFolder As Folder
    Dim File As File
    Dim i As Integer
    Dim CopyR As Range
    Dim FSO As Object ' FileSystemObject for reliable file extension checks
    Dim hooverExtracted As Boolean ' Flag to track if we've pulled a file from "hoover test"
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    hooverExtracted = False ' Start with no files extracted from hoover test
    
    ' Process files in the current folder
    For Each File In Folder.Files
        ' Only process .xlsx files (case-insensitive check)
        If LCase(FSO.GetExtensionName(File.Name)) = "xlsx" Then
            ' Handle the "hoover test" folder special case
            If Folder.Name = "hoover test" Then
                If Not hooverExtracted Then
                    ' Paste your existing file extraction/merge code here
                    ' Example:
                    ' Workbooks.Open(File.Path)
                    ' Set CopyR = ActiveSheet.UsedRange
                    ' CopyR.Copy ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                    ' ActiveWorkbook.Close SaveChanges:=False
                    
                    hooverExtracted = True ' Mark that we've grabbed our one file here
                End If
            Else
                ' Process all .xlsx files in regular folders
                ' Paste your existing file extraction/merge code here
                ' Example:
                ' Workbooks.Open(File.Path)
                ' Set CopyR = ActiveSheet.UsedRange
                ' CopyR.Copy ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                ' ActiveWorkbook.Close SaveChanges:=False
            End If
        End If
    Next File
    
    ' Recursively process subfolders
    For Each SubFolder In Folder.SubFolders
        ' Reset the flag if we're entering a new "hoover test" subfolder
        If SubFolder.Name = "hoover test" Then
            hooverExtracted = False
        End If
        DoFolder SubFolder
    Next SubFolder
    
    ' Clean up objects
    Set FSO = Nothing
End Sub

Key Changes Explained #

• .xlsx Filter: We use LCase(FSO.GetExtensionName(File.Name)) to do a case-insensitive check for the .xlsx extension—this avoids missing files with uppercase extensions like .XLSX.
• "hoover test" Single File Limit: The hooverExtracted boolean flag keeps track of whether we’ve already processed a file in the target folder. Once we process the first valid .xlsx file, we flip the flag to True and skip the rest in that folder. We also reset the flag when entering a new "hoover test" subfolder, so nested instances of the folder each contribute one file.
• Recursive Logic: The subfolder loop maintains the flag behavior, ensuring the special rule applies to every "hoover test" folder, no matter how deep it is in your directory structure.

Just replace the example extraction code comments with your existing logic for opening, copying, and merging the Excel data, and you’re good to go!

内容的提问来源于stack exchange，提问作者myles collier