在多个子文件夹中搜索文件的VBA宏 [英] VBA macro that search for file in multiple subfolders
问题描述
是否可以使这项工作没有特定的文件夹位置?我需要一些可以通过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屋!