Oscar Sun

                  Sub 資料夾重新命名()
Dim fs, fc, fl, f ', OldName As String, NewName As String
'p = ""InputBox("請輸入路徑", , p)
Const p = "X:\!!來自H筆電第3批" '"請輸入路徑"
'If Dir(p) = "" Then MsgBox "請檢查路徑": Exit Sub
Const o = "!!" '被取代字串
Const n = "@@@" '取代字串
If p = "" Then Exit Sub
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(p)
Set fc = f.subFolders '.Files
For Each fl In fc
    fl.Name = Replace(fl.Name, o, n)
    
Next fl
End Sub