脚本功能解析

该脚本的主要作用是“扁平化”指定文件夹（Y:\YeonWoo）下所有一级子文件夹的内部目录结构。

具体逻辑如下：

1. 遍历根目录：针对 Y:\YeonWoo 里的每一个一级文件夹（父文件夹）。
2. 提取文件：递归遍历这些一级文件夹内部的所有子文件夹，将里面的所有文件全部移动到该一级文件夹的根目录下。
3. 处理同名冲突：如果移动时遇到重名文件，会自动在文件名后加上下划线和序号（如 photo_1.jpg）以防覆盖。
4. 清理空目录：将文件全部提出后，彻底删除这些一级文件夹内部的所有子文件夹，仅留下一级文件夹和其中的所有文件。

Option Explicit

Dim fso, topPath, topFolder, folder

' 顶级目录
topPath = "Y:\YeonWoo"

Set fso = CreateObject("Scripting.FileSystemObject")

If Not fso.FolderExists(topPath) Then
    MsgBox "Path not found: " & topPath, vbCritical, "Error"
    WScript.Quit
End If

Set topFolder = fso.GetFolder(topPath)

For Each folder In topFolder.SubFolders
    ProcessParentFolder folder.Path
Next

MsgBox "Done!", vbInformation, "Finished"


Sub ProcessParentFolder(parentPath)
    Dim parentFolder

    If Not fso.FolderExists(parentPath) Then Exit Sub

    Set parentFolder = fso.GetFolder(parentPath)

    ' 先移动所有子目录里的文件到当前一级文件夹
    MoveFilesFromSubFolders parentFolder, parentPath

    ' 再删除所有子目录
    DeleteAllSubFolders parentFolder
End Sub


Sub MoveFilesFromSubFolders(folderObj, parentPath)
    On Error Resume Next

    Dim subFolder, fileObj
    Dim destPath

    ' 只处理子目录里的文件，不动 parentPath 第一层已有文件
    For Each subFolder In folderObj.SubFolders

        ' 先递归处理更深层子目录
        MoveFilesFromSubFolders subFolder, parentPath

        ' 再移动当前子目录里的文件
        For Each fileObj In subFolder.Files
            destPath = GetUniquePath(parentPath, fileObj.Name)
            Err.Clear
            fso.MoveFile fileObj.Path, destPath
        Next
    Next

    On Error GoTo 0
End Sub


Function GetUniquePath(parentPath, fileName)
    Dim baseName, extName, destPath, i

    baseName = fso.GetBaseName(fileName)
    extName = fso.GetExtensionName(fileName)

    destPath = fso.BuildPath(parentPath, fileName)
    i = 1

    Do While fso.FileExists(destPath)
        If extName <> "" Then
            destPath = fso.BuildPath(parentPath, baseName & "_" & i & "." & extName)
        Else
            destPath = fso.BuildPath(parentPath, baseName & "_" & i)
        End If
        i = i + 1
    Loop

    GetUniquePath = destPath
End Function


Sub DeleteAllSubFolders(folderObj)
    On Error Resume Next

    Dim subFolder

    ' 先删除更深层目录
    For Each subFolder In folderObj.SubFolders
        DeleteAllSubFolders subFolder
    Next

    ' 再删除当前层子目录
    For Each subFolder In folderObj.SubFolders
        Err.Clear
        fso.DeleteFolder subFolder.Path, True
    Next

    On Error GoTo 0
End Sub