批量改文件夹名

tiantao186

lisongmei

循环一下就好了
Name "C:\Users\xx\Desktop\aa" As "C:\Users\xx\Desktop\aab"

baofa2

1. Sub test0()
   
2.   Dim ar, p As String, i As Long
   
3.   p = ThisWorkbook.Path & "\"
   
4.   ar = Range("B1").CurrentRegion.Value
   
5.   For i = 1 To UBound(ar)
   
6.     If Len(Dir(p & ar(i, 1), vbDirectory)) Then Name p & ar(i, 1) As p & ar(i, 3)
   
7.   Next
   
8.   Beep
   
9. End Sub
   

复制代码

yanglinzi

1. Sub 文件夹改名()
   
2. Dim arr, i, j, fso
   
3. Set fso = CreateObject("scripting.filesystemobject")
   
4. p = ThisWorkbook.Path & "" & ""
   
5. For Each ws In fso.getfolder(p).subFolders
   
6.     xa = Split(ws.Name, "夹")
   
7.     ws.Name = "改名后" & xa(1)
   
8. Next
   
9. End Sub
   

复制代码

yanglinzi

参与一下。。

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.5.9
   
2.     Set fso = CreateObject("Scripting.FileSystemObject")
   
3.     p = ThisWorkbook.Path
   
4.     r = Cells(Rows.Count, 1).End(3).Row
   
5.     arr = [a1].Resize(r, 3)
   
6.     For i = 1 To r
   
7.         sc = p & "" & arr(i, 1)
   
8.         dt = p & "" & arr(i, 3)
   
9.         fso.MoveFolder sc, dt
   
10.     Next
    
11.     MsgBox "OK！"
    
12. End Sub
    
13. 
    

复制代码