【求助】按照规则重命名文件夹内多个子文件夹下的文件

欧米伽11

文件夹1.28资料  内有多个子文件夹，每个子文件夹内有3个.xls文件
其中有两个文件是带了“PL” 或者“CI”字符，这两个文件不需要改名，
只重命名 名字中不带PL或者CI字符的文件
重命名的规则是 当前子文件夹名字中第一个空格的前部分替换到需要命名的文件名字中空格的前半部分
例如子文件名字 LB190128-3 MEL 2HQ3.11
当前子文件内不带CI或者 PL字符的文件名字为LB180716-3 MELB
重命名后的结果为 LB190128-3 MELB.xls

命名前的状态

==》

命名后的效果

恳请有兴趣的老师帮忙解决，年底工作量太大了，忙不过来。
模拟文件夹.zip (182.37 KB, 下载次数: 21)

2019-1-9 14:59 上传

点击文件名下载附件

欧米伽11

平时不学习，临时抱佛脚。惭愧，惭愧

dsmch

……………………

欧米伽11

dsmch 发表于 2019-1-9 15:59
……………………

多谢前辈，我试试是否可以。感激

limonet

关键字：replace $1

limonet

Sub limonet()
    CreateObject("wscript.shell").Run "powershell push-location " & ThisWorkbook.Path _
    & ";dir -file -recurse -exclude '*CI.xls','*PL.xls','*.xlsm' | % {Ren $_ " _
    & "(($_.directory -replace '.*\\(.*? ).*','$1')+($_.name -replace '.* ',''))}", 0
End Sub

ykcbf1100

练手，批量重命名文件

ykcbf1100

批量重命名文件，正则+fso

1. Sub ykcbf()   '//2024.6.3  多个子目录下的指定类型文件重命名
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set fso = CreateObject("scripting.filesystemobject")
   
5.     Set reg = CreateObject("VBScript.Regexp")
   
6.     With reg
   
7.         .Global = False
   
8.         .Pattern = "PL|CI"
   
9.     End With
   
10.     p = ThisWorkbook.Path & "\1.28资料"
    
11.     On Error Resume Next
    
12.     Set ff = fso.GetFolder(p)
    
13.     For Each fd In ff.SubFolders
    
14.         For Each f In fd.Files
    
15.             s = UCase(f.Name)
    
16.             If Not reg.test(s) Then
    
17.                 fn = Split(fd.Name)(0) & " " & Mid(s, Len(Split(s)(0)) + 2)
    
18.                 f.Name = fn
    
19.             End If
    
20.         Next f
    
21.     Next fd
    
22.     Set fso = Nothing
    
23.     Set reg = Nothing
    
24.     Application.ScreenUpdating = True
    
25.     MsgBox "OK！"
    
26. End Sub
    

复制代码