[已解决]批量修改文件夹编号的问题

阿柔

hwc2ycy 发表于 2014-5-10 10:46
不好意思，没有测试到其他的数据，刚测了从1-50.

老师您好，今天试用修改众多文件夹名时，出现了错误提示。
试了一下，修改1--49或1--52时，很正常。多一个都报错。

因工作需要，要修改1--600或更多。不知能否麻烦您看看？谢谢了。

hwc2ycy

阿柔 发表于 2014-5-26 11:20
老师您好，今天试用修改众多文件夹名时，出现了错误提示。
试了一下，修改1--49或1--52时，很正常。多一 ...

1. Sub demo1()
   
2.     Dim strPath$, strName$
   
3.     Dim l%
   
4.     Dim strNewName$
   
5.     strPath = ThisWorkbook.Path & Application.PathSeparator
   
6.     strName = Dir(strPath & "*.*", vbDirectory)
   
7.     Do While Len(strName)
   
8.         strNewName = ""
   
9.         If (GetAttr(strPath & strName) And vbDirectory) = vbDirectory Then
   
10.             l = Val(strName)
    
11.             If l Then
    
12.                 strNewName = Replace(Cells(1, l).Address(False, False), 1, "")
    
13.                 Name strPath & strName As strPath & strNewName
    
14.             End If
    
15.         End If
    
16.         strName = Dir
    
17.     Loop
    
18.     MsgBox "重命名完成"
    
19. End Sub

复制代码

直接用取巧的方法，最多可以到16384。