在多个子文件夹中搜索文件的VBA宏

Question

在多个子文件夹中搜索文件的VBA宏我有宏，如果我放入文件的单元格E1名称，宏搜索通过C：\ Users \ Marek \ Desktop \ Makro \目录，找到它并将所需的值放在我的原始文件的特定单元格中。是否可以在没有特定文件夹位置的情况下完成此工作？我需要一些可以搜索C：\ Users \ Marek \ Desktop \ Makro \的东西，里面有很多子文件夹。我的代码：Sub Zila1()Dim SaveDriveDir As String, MyPath As StringDim FName As VariantDim YrMth As StringSaveDriveDir = CurDir MyPath = Application.DefaultFilePath    'or use "C:\Data"ChDrive MyPath ChDir MyPath FName = Sheets("Sheet1").Range("E1").TextIf FName = False Then     'do nothingElse     GetData "C:\Users\Marek\Desktop\Makro\" & FName & ".xls", "Vystupna_kontrola", _        "A16:A17", Sheets("Sheet1").Range("B2:B3"), True, False         GetData "C:\Users\Marek\Desktop\Makro\" & FName & ".xls", "Vystupna_kontrola", _        "AE23:AE24", Sheets("Sheet1").Range("B3:B4"), True, False         GetData "C:\Users\Marek\Desktop\Makro\" & FName & ".xls", "Vystupna_kontrola", _        "AE26:AE27", Sheets("Sheet1").Range("B4:B5"), True, False         GetData "C:\Users\Marek\Desktop\Makro\" & FName & ".xls", "Vystupna_kontrola", _        "AQ59:AQ60", Sheets("Sheet1").Range("B5:B6"), True, False         GetData "C:\Users\Marek\Desktop\Makro\" & FName & ".xls", "Vystupna_kontrola", _        "AR65:AR66", Sheets("Sheet1").Range("B6:B7"), True, False         End If   ChDrive SaveDriveDir   ChDir SaveDriveDirEnd Sub

Answer 1

此子将填充一个Collection，其中包含与您传入的文件名或模式匹配的所有文件。

Sub GetFiles(StartFolder As String, Pattern As String, _
             DoSubfolders As Boolean, ByRef colFiles As Collection)

    Dim f As String, sf As String, subF As New Collection, s    If Right(StartFolder, 1) <> "\" Then StartFolder = StartFolder & "\"

    f = Dir(StartFolder & Pattern)
    Do While Len(f) > 0
        colFiles.Add StartFolder & f
        f = Dir()
    Loop

    sf = Dir(StartFolder, vbDirectory)
    Do While Len(sf) > 0
        If sf <> "." And sf <> ".." Then
            If (GetAttr(StartFolder & sf) And vbDirectory) <> 0 Then
                    subF.Add StartFolder & sf            End If
        End If
        sf = Dir()
    Loop

    For Each s In subF
        GetFiles CStr(s), Pattern, True, colFiles    Next sEnd Sub

用法：

Dim colFiles As New Collection

GetFiles "C:\Users\Marek\Desktop\Makro\", FName & ".xls", True, colFilesIf colFiles.Count > 0 Then
    'work with found filesEnd If