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

问题描述

我有宏，如果我放入单元格E1文件的名称，宏搜索通过C：\Users\Marek\Desktop\Makro\目录，找到它，并将所需的值放在特定单元格中我的原始文件与宏。

是否可以使这项工作没有特定的文件夹位置？我需要一些可以通过C：\Users\Marek\Desktop\Makro\搜索的东西，其中有许多子文件夹。

我的代码是

  Sub Zila1（）
 Dim SaveDriveDir As String，MyPath As String 
 Dim FName As Variant 
 Dim YrMth As String 
 
 
 SaveDriveDir = CurDir 
 MyPath = Application.DefaultFilePath'或使用C：\Data
 ChDrive MyPath 
 ChDir MyPath 
 FName = Sheets（Sheet1）。Range（E1）。Text 
 
 
 
如果FName = False然后
'do nothing 
 Else 
 GetDataC：\Users\Marek\Desktop\Makro\ FName& .xls，Vystupna_kontrola，_ 
A16：A17，Sheets（Sheet1）。Range（B2：B3），True，False 
 
 GetDataC ：\Users\Marek\Desktop\Makro\& FName& .xls，Vystupna_kontrola，_ 
AE23：AE24，Sheets（Sheet1）。Range（B3：B4），True，False 
 
 GetDataC ：\Users\Marek\Desktop\Makro\& FName& .xls，Vystupna_kontrola，_ 
AE26：AE27，Sheets（Sheet1）。Range（B4：B5），True，False 
 
 GetDataC ：\Users\Marek\Desktop\Makro\& FName& .xls，Vystupna_kontrola，_ 
AQ59：AQ60，Sheets（Sheet1）。Range（B5：B6），True，False 
 
 GetDataC ：\Users\Marek\Desktop\Makro\& FName& .xls，Vystupna_kontrola，_ 
AR65：AR66，Sheets（Sheet1）。Range（B6：B7），True，False 
 
 
 
 
 
 
如果
 
 ChDrive SaveDriveDir 
 ChDir SaveDriveDir 
  

End Sub

解决方案

只是为了好玩，递归函数（我希望）应该更容易理解并与您的代码一起使用：

 函数重新执行（sPath As String）As String 
 
 Dim FSO As New FileSystemObject 
 Dim myFolder As folder 
 Dim mySubFolder As Folder 
 
设置myFolder = FSO.GetFolder（sPath） 
对于每个mySubFolder在myFolder.SubFolders 
调用TestSub（mySubFolder.Path）
 Recurse = Recurse（mySubFolder.Path）
下一个
 
结束函数
 
 Sub TestR（）
 
调用Recurse（D：\Projets\）
 
 End Sub 
 
 Sub TestSub（ByVal s As Strin g）
 
 Debug.Print s 
 
 End Sub 
  

  Sub TestSub（ByVal s As String）
 
 Dim FSO As New FileSystemObject 
 Dim myFolder As Folder 
 Dim myFile As File 
 
设置myFolder = FSO.GetFolder（s）
对于每个myFile在myFolder.Files 
如果myFile.Name =范围（E1）。值然后
调试。打印myFile.Name'或做任何你想要的文件
结束如果
下一个
 
 End Sub 
  

调试找到的文件的名称，其余的取决于你。 ;）

当然有人会说这两次调用FileSystemObject有点笨拙，所以你可以简单地编写你的代码（这取决于你想要划分的内容，不是）

 函数Recurse（sPath As String）As String 
 
 Dim FSO As New FileSystemObject 
 Dim myFolder As Folder 
 Dim mySubFolder As Folder 
 Dim myFile As File 
 
设置myFolder = FSO.GetFolder（sPath）
 
对于每个mySubFolder在myFolder.SubFolders 
对于每个myFile在mySubFolder.Files 
如果myFile.Name = Range（E1）。然后
 Debug.Print myFile.Name& in& myFile.Path'或任何你想要的文件
退出为
结束如果
下一个
 Recurse = Recurse（mySubFolder.Path）
下一个
 
结束函数
 
 Sub TestR（）
 
调用Recurse（D：\Projets\）
 
 End Sub 
  

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

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

My code is

    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:\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 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

Edit: 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. ;)

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屋！