按条件打开文件夹，给其里面所有工作簿批量修改文件名

sampsonpon

打开同一路径下的"PICKING LIST"文件夹，找到"List-当月当日"文件夹后，按文件修改时间的升序，将每一个文件名末尾不为"Read"且文件名不含"CY"或不含"HQ"或不含"RFI"的工作簿修改其文件名为它本身工作簿名称+"Read"

如下图，在TEST里按钮操作，批量修改当天文件夹下所有.xlsx文件名

limonet

关键字：-notmatc

limonet

Sub limonet()
    CreateObject("wscript.shell").Run "powershell push-location (join-path " & ThisWorkbook.Path _
    & " ('PICKING LIST\List-{0:M}' -f (Get-Date)));dir | %{if ($_.basename -notmatch '.*?[CY|HQ|RFI].*?Read'){Rename-Item $_.fullname ($_.Basename+'Read'+$_.Extension)}}", 0
End Sub

ykcbf1100

原代码是我写的。
但这里不需要字典，重命名而已，不需要那么复杂。

ykcbf1100

原代码上改一下吧。

1. Sub ykcbf()    '//2024.8.14
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set fso = CreateObject("scripting.filesystemobject")
   
5.     Set reg = CreateObject("VBScript.Regexp")
   
6.     p = ThisWorkbook.Path & "\PICKING LIST" & "List-" & Format(Date, "m月d日") & ""
   
7.     With reg
   
8.         .Global = False
   
9.         .Pattern = "Read|CY|HQ|RFI"
   
10.     End With
    
11.     For Each f In fso.GetFolder(p).Files
    
12.         If LCase$(f.Name) Like "*.xls*" Then
    
13.             fn = fso.GetBaseName(f)
    
14.             If Not reg.test(fn) Then
    
15.                 f.Name = fn & "Read" & "." & fso.GetExtensionName(f)
    
16.             End If
    
17.         End If
    
18.     Next f
    
19.     Application.ScreenUpdating = True
    
20.     Application.DisplayAlerts = True
    
21.     MsgBox "OK！"
    
22. End Sub
    

复制代码

usedrange

1. Sub copyToOrg2()
   
2.     Dim fso, fd, fs, f, p$, t
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Set fso = CreateObject("scripting.filesystemobject")
   
6.     p = ThisWorkbook.Path & "\PICKING LIST"
   
7.     Set fd = fso.getfolder(p).subfolders
   
8.     For Each fs In fd
   
9.         For Each f In fso.getfolder(fs).Files
   
10.             t = Split(f.Name, ".")(0)
    
11.             If Mid(t, Len(t) - Len("Read") + 1) <> "Read" And InStr(t, "CY") = 0 And InStr(t, "HQ") = 0 And InStr(t, "RFI") = 0 Then
    
12.                 f.Name = t & "Read.xlsx"
    
13.             End If
    
14.         Next f
    
15.     Next fs
    
16.     Set fso = Nothing
    
17.     Set fd = Nothing
    
18.     Application.ScreenUpdating = True
    
19.     Application.DisplayAlerts = True
    
20. End Sub

复制代码