关于关键字批量移动文件的问题求助各位老师。

从小就打架

各位老师好，需要在文件夹中通过关键字查找文件然后移动或者复制到指定的文件夹里面去。。
之前自己研究了一下只能实现在某个目录下移动，但是我的文件一般都会涉及1层或者2层子目录，我实在无法搞定了。所以求助各位老师帮忙搞定一下。在1层或2层子文件夹下面怎么通过关键字批量移动或者复制文件到指定目录。

附件是文件夹结构。

liulang0808

http://club.excelhome.net/thread-1258425-1-1.html
这个文件遍历及文件操作的资料，楼主可以参考下

从小就打架

liulang0808 发表于 2018-12-25 12:30
http://club.excelhome.net/thread-1258425-1-1.html
这个文件遍历及文件操作的资料，楼主可以参考下

我就是抱着这个帖子看了研究了半天，还是搞不定呀。

liulang0808

从小就打架 发表于 2018-12-25 14:04
我就是抱着这个帖子看了研究了半天，还是搞不定呀。

楼主具体要干什么，能不能结合附件举例模拟需求

limonet

关键字：-in

limonet

Sub limonet()
    CreateObject("wscript.shell").Run "powershell push-location " & ThisWorkbook.Path _
    & ";dir -file -Recurse -exclude *.xlsm | % {if ($_.basename -in ('数据 (5)','文本 (2)','文档 (3)')){move $_}}", 0
End Sub

ykcbf1100

练手，批量文件移动，二级子目录

ykcbf1100

练手。。。

1. Sub ykcbf()  '//2024.6.11    '//按关键字批量文件移动
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set fso = CreateObject("Scripting.FileSystemObject")
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     p = ThisWorkbook.Path & ""
   
7.     p1 = p & "新文件夹"
   
8.     If Not fso.FolderExists(p1) Then fso.CreateFolder p1
   
9.     Set sh = ThisWorkbook.Sheets("Sheet1")
   
10.     With sh
    
11.         For i = 2 To 4
    
12.             s = .Cells(i, 1)
    
13.             d(s) = ""
    
14.         Next
    
15.     End With
    
16.     For Each fd In fso.GetFolder(p).SubFolders
    
17.         For Each fd1 In fso.GetFolder(fd).SubFolders
    
18.             For Each f In fd1.Files
    
19.                 fn = fso.GetBaseName(f)
    
20.                 If d.exists(fn) Then
    
21.                     fso.MoveFile f, p1
    
22.                 End If
    
23.             Next f
    
24.         Next fd1
    
25.     Next fd
    
26.     Application.ScreenUpdating = True
    
27.     MsgBox "OK！"
    
28. End Sub
    
29. 
    

复制代码