多文件夹批量更名（遍历递归）

lizhipei78

如下图所示，有多个文件夹，不一定是6个，文件夹数量有变动。


然后每个文件夹下有不同的文件，里面没有二层文件夹了。
现在我想把里面的文件依次以序号进行重命名，最主要是为了方便整合统一打印，目的是每个文件夹能分类，但是又能按文件夹顺序整理成一个文档。
依次重命名后我就可以把这些文档一次性提出来，然后按名称就能排序了，打印合并什么的就不会乱了。
对于单个文件夹的重命名我会，但是多个批量的我就不会了。
希望大神帮忙写一个代码，之前有看到一个遍历递归的帖子，应该能实现，但是代码太多了，不会改。
或者我这个想法还有有什么办法实现吗？


附件为测试用，实测没有什么内容。
多文件夹更名.rar (1.53 KB, 下载次数: 19)

2023-5-5 13:54 上传

点击文件名下载附件

limonet

A文件夹里面的文件重命名为1、2、3、4……？

lizhipei78

limonet 发表于 2023-5-5 15:15
A文件夹里面的文件重命名为1、2、3、4……？

是的，依次是001、002……然后下一个文件夹内的文件接着上一个文件夹的序号，如005、006这样子

ykcbf1100

附件请参考。。。

lizhipei78

ykcbf1100 发表于 2023-5-5 15:34
附件请参考。。。

感谢写代码，可能你没有理解我的意思，我要的不是删除那个文字，我想的是依次对文件夹内的文件进行重命名，文件的名称为001、002……，如该示例中A文件夹的四个文件，重命名为001、002、003、004，然后到下一个B文件夹内的三个文件为005、006、007一直这样子下去。
你可以不用判断文件夹内的类型，就是依次对这些文件进行重命名就好了，当然后缀还得保留。

ykcbf1100

lizhipei78 发表于 2023-5-5 16:08
感谢写代码，可能你没有理解我的意思，我要的不是删除那个文字，我想的是依次对文件夹内的文件进行重命名 ...

更简单了。

lizhipei78

ykcbf1100 发表于 2023-5-5 16:17
更简单了。

非常感谢，好人
热情助人，经常见到你的身影，且我也从你的代码中学到了好多知识
感谢

limonet

代码在审核。

limonet

Dim i%
Sub limonet()
    Dim Path$
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then Path = .SelectedItems(1) Else Exit Sub
    End With
    Call AllListFSO(Path)
End Sub
Function AllListFSO(Path) As String
    Dim Fld As Object, Fd As Object, F As Object
    Set Fld = CreateObject("scripting.filesystemobject").getfolder(Path)
    For Each F In Fld.Files
        i = i + 1
        Name F.Path As Fld.Path & "\" & Format(i, "000") & Mid(F.Name, InStrRev(F.Name, "."), 99)
    Next F
    For Each Fd In Fld.subfolders
        AllListFSO (Fd.Path)
    Next Fd
End Function

lizhipei78

limonet 发表于 2023-5-5 16:45
代码在审核。

非常感谢，测试了，你的代码是对每一个文件夹进行次序命名，我要的是累加命名，即是到B文件夹后就变成005了，不是又变回001
我尝试了一下，把i=i+1放到外面循环，会出错，能不能帮我再改一下
就是这句代码放在什么位置合适