多级文件夹下面查找指定文件， 并把这些文件拷贝到一个目标文件夹内

limonet

关键字：recurse

limonet

Sub limonet()
    CreateObject("wscript.shell").Run "powershell push-location " & ThisWorkbook.Path _
    & ";dir -file -recurse -include (get-content 查找.txt) | %{move $_.fullname 目标文件夹}", 0
End Sub

ykcbf1100

改一下，换个方法

1. Sub ykcbf()          '//2024.8.26   文件复制
   
2.     Dim fns As New Collection
   
3.     Application.ScreenUpdating = False
   
4.     Set fso = CreateObject("Scripting.FileSystemObject")
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     p = ThisWorkbook.Path & ""
   
7.     p1 = p & "产品级别"
   
8.     p2 = p & "目标文件夹"
   
9.     f = p & "查找.txt"
   
10.     Set wb = Workbooks.Open(f, 0)
    
11.     arr = wb.Sheets(1).UsedRange
    
12.     wb.Close 0
    
13.     For Each k In arr
    
14.         st = st & "|" & k
    
15.     Next
    
16.     getfiles fso, p1, fns, st, d
    
17.     For Each k In fns
    
18.         fso.CopyFile k(0), p2 & k(1)
    
19.     Next
    
20.     Application.ScreenUpdating = True
    
21.     MsgBox "OK！"
    
22. End Sub
    

复制代码

limonet

抱歉，代码用这个。
Sub limonet()
    CreateObject("wscript.shell").Run "powershell push-location " & ThisWorkbook.Path _
    & ";dir .\产品级别 -file -recurse -include (get-content 查找.txt) | %{copy $_.fullname 目标文件夹}", 0
End Sub

前进者

这个案例挺实用，mark一下，感谢大佬！