在多个子文件夹中搜索文件的 VBA 宏 [英] VBA macro that search for file in multiple subfolders

问题描述

我有宏，如果我输入文件的单元格 E1 名称，宏搜索槽 C:UsersMarekDesktopMakro 目录，找到它并使用宏将所需的值放在我的原始文件的特定单元格中.

I have macro, if I put in cell E1 name of the file, macro search trough C:UsersMarekDesktopMakro directory, find it and put the needed values in specific cells of my original file with macro.

是否可以在没有特定文件夹位置的情况下进行这项工作?我需要一些可以在 C:UsersMarekDesktopMakro 中搜索的东西，其中包含许多子文件夹.

Is it possible to make this work without specific folder location? I need something that can search trough C:UsersMarekDesktopMakro with many subfolders in it.

我的代码:

Sub Zila1()
Dim SaveDriveDir As String, MyPath As String
Dim FName As Variant
Dim YrMth As String

SaveDriveDir = CurDir
MyPath = Application.DefaultFilePath    'or use "C:Data"
ChDrive MyPath
ChDir MyPath
FName = Sheets("Sheet1").Range("E1").Text

If FName = False Then
    'do nothing
Else
    GetData "C:UsersMarekDesktopMakro" & FName & ".xls", "Vystupna_kontrola", _
        "A16:A17", Sheets("Sheet1").Range("B2:B3"), True, False

        GetData "C:UsersMarekDesktopMakro" & FName & ".xls", "Vystupna_kontrola", _
        "AE23:AE24", Sheets("Sheet1").Range("B3:B4"), True, False

        GetData "C:UsersMarekDesktopMakro" & FName & ".xls", "Vystupna_kontrola", _
        "AE26:AE27", Sheets("Sheet1").Range("B4:B5"), True, False

        GetData "C:UsersMarekDesktopMakro" & FName & ".xls", "Vystupna_kontrola", _
        "AQ59:AQ60", Sheets("Sheet1").Range("B5:B6"), True, False

        GetData "C:UsersMarekDesktopMakro" & FName & ".xls", "Vystupna_kontrola", _
        "AR65:AR66", Sheets("Sheet1").Range("B6:B7"), True, False

        End If

  ChDrive SaveDriveDir
  ChDir SaveDriveDir
End Sub

推荐答案

只是为了好玩，这里有一个带有递归函数的示例，(我希望)它应该更容易理解并与您的代码一起使用:

Just for fun, here's a sample with a recursive function which (I hope) should be a bit simpler to understand and to use with your code:

Function Recurse(sPath As String) As String

    Dim FSO As New FileSystemObject
    Dim myFolder As Folder
    Dim mySubFolder As Folder

    Set myFolder = FSO.GetFolder(sPath)
    For Each mySubFolder In myFolder.SubFolders
        Call TestSub(mySubFolder.Path)
        Recurse = Recurse(mySubFolder.Path)
    Next

End Function

Sub TestR()

    Call Recurse("D:Projets")

End Sub

Sub TestSub(ByVal s As String)

    Debug.Print s

End Sub

以下是如何在工作簿中实施此代码以实现目标.

Here's how you can implement this code in your workbook to achieve your objective.

Sub TestSub(ByVal s As String)

    Dim FSO As New FileSystemObject
    Dim myFolder As Folder
    Dim myFile As File

    Set myFolder = FSO.GetFolder(s)
    For Each myFile In myFolder.Files
        If myFile.Name = Range("E1").Value Then
            Debug.Print myFile.Name 'Or do whatever you want with the file
        End If
    Next

End Sub

这里，我只是调试找到的文件的名称，剩下的就靠你了.;)

Here, I just debug the name of the found file, the rest is up to you. ;)

当然，有人会说两次调用 FileSystemObject 有点笨拙，因此您可以简单地编写这样的代码(取决于您是否要进行分区):

Of course, some would say it's a bit clumsy to call twice the FileSystemObject so you could simply write your code like this (depends on wether you want to compartmentalize or not):

Function Recurse(sPath As String) As String

    Dim FSO As New FileSystemObject
    Dim myFolder As Folder
    Dim mySubFolder As Folder
    Dim myFile As File

    Set myFolder = FSO.GetFolder(sPath)

    For Each mySubFolder In myFolder.SubFolders
        For Each myFile In mySubFolder.Files
            If myFile.Name = Range("E1").Value Then
                Debug.Print myFile.Name & " in " & myFile.Path 'Or do whatever you want with the file
                Exit For
            End If
        Next
        Recurse = Recurse(mySubFolder.Path)
    Next

End Function

Sub TestR()

    Call Recurse("D:Projets")

End Sub

这篇关于在多个子文件夹中搜索文件的 VBA 宏的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！