怎么复制或剪切文件到相关名称的文件夹？VBA能完成吗？

jmjslkj

一个文件夹中有很多文件，如张三-1.doc、张三-2.doc、张三-1.xls、张三-2.xls、、张三-1.txt、张三-2.txt、张三-3.txt、李四-1.doc、李四-2.doc、李四-3.doc、李四-1.xls、李四-2.xls、李四-3.xls、李四-1.txt、李四-2.txt、……我也新建了文件夹”张三”、”李四”……有没有批处理命令把和张三相关的文件复制文件夹”张三”， 把和李四相关的文件复制文件夹”李四” ……

dqhtju

用FSO的move
有空再做

jsgj2023

搜chxw68老师的帖子，记得他写过类似的代码 。

limonet

关键字：-include

limonet

Sub limonet()
    CreateObject("wscript.shell").Run "powershell push-location " & ThisWorkbook.Path _
    & ";dir -dir |%{Move (dir .\* -file -include ($_.name+'*')) $_}", 0
End Sub

ykcbf1100

练手，文件归类

ykcbf1100

练习一下，文件归类，fso法

1. Sub ykcbf()     '//2024.6.13   文件归类
   
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.     For Each fd In fso.GetFolder(p).SubFolders
   
8.         d(fd.Name) = ""
   
9.     Next fd
   
10.     For Each k In d.keys
    
11.         For Each f In fso.GetFolder(p).Files
    
12.             If InStr(f.Name, k) Then
    
13.                 fso.MoveFile f, p & k & ""
    
14.             End If
    
15.         Next f
    
16.     Next
    
17.     Set d = Nothing
    
18.     Application.ScreenUpdating = True
    
19.     MsgBox "OK！"
    
20. End Sub
    

复制代码