如何用VBA提取子文件夹指定后缀重命名文件并批量迁移

以下是修改后的VBA代码，可实现提取子文件夹名称中第二个下划线后的数字作为前缀，将文件重命名后迁移到统一的目标文件夹：

Sub doIt()
' Add reference: Tools->References->Microsoft Scripting Runtime
Dim fso As FileSystemObject
Dim fldMain As Folder
Dim fld As Folder
Dim fil As File
Dim targetFolderPath As String
Dim folderNameParts As Variant
Dim prefix As String

    Set fso = New FileSystemObject
   
    ' 主文件夹路径（从A7单元格读取）
    Set fldMain = fso.GetFolder(Range("A7").Value)
    
    ' 定义统一目标文件夹（创建在主文件夹下，命名为"Processed_Files"）
    targetFolderPath = fldMain.Path & Application.PathSeparator & "Processed_Files"
    ' 如果目标文件夹不存在则创建
    If Not fso.FolderExists(targetFolderPath) Then
        fso.CreateFolder targetFolderPath
    End If
   
    ' 遍历所有子文件夹
    For Each fld In fldMain.SubFolders
        ' 拆分子文件夹名称，按下划线分割
        folderNameParts = Split(fld.Name, "_")
        ' 提取第二个下划线后的数字作为前缀（数组下标从0开始，第三个元素即为目标内容）
        If UBound(folderNameParts) >= 2 Then
            prefix = folderNameParts(2) & "_"
        Else
            ' 如果子文件夹名称格式不符合，用原文件夹名作为前缀（可选处理）
            prefix = fld.Name & "_"
        End If
        
        ' 遍历子文件夹内的所有文件
        For Each fil In fld.Files
            With fil
                ' 将文件移动到目标文件夹，并重命名为前缀+原文件名
                .Move targetFolderPath & Application.PathSeparator & prefix & .Name
            End With
        Next fil
    Next fld
    
    Set fso = Nothing
    MsgBox "文件处理完成！"
End Sub

关键修改说明： #

• 提取目标前缀：使用Split(fld.Name, "_")将子文件夹名称按下划线拆分为数组，取下标为2的元素（对应第二个下划线后的内容），并添加下划线作为前缀。如果子文件夹名称格式不符合（下划线数量不足），会 fallback 到原文件夹名作为前缀，避免报错。
• 创建统一目标文件夹：在主文件夹下创建名为Processed_Files的文件夹，用于存放所有处理后的文件，提前判断文件夹是否存在，防止重复创建报错。
• 迁移并重命名：修改.Move方法的目标路径为统一文件夹，文件名替换为提取的前缀+原文件名，直接完成迁移和重命名操作。

使用注意事项： #

1. 确保已添加Microsoft Scripting Runtime引用（按代码注释中的路径操作：Tools->References->勾选Microsoft Scripting Runtime）。
2. 主文件夹路径需正确填写在Excel的A7单元格中。
3. 如果存在同名文件，迁移时会覆盖目标文件夹中的现有文件，若需要避免覆盖，可添加文件存在判断逻辑。

内容的提问来源于stack exchange，提问作者JPrin001