在多个子文件夹中搜索文件的 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屋!