功能是：

E:\139
├─ 文件夹A
│ ├─ 子目录1\图片1.jpg
│ ├─ 子目录2\视频1.mp4
│ └─ 图片2.jpg

• 运行后变成：

E:\139
├─ 文件夹A
│ ├─ 图片1.jpg
│ ├─ 视频1.mp4
│ └─ 图片2.jpg

1.把每个一级文件夹里面所有子目录的文件移动到一级文件夹内，然后删除空子目录。

2.一级文件夹里原本已经存在的文件不会被重新命名，只会移动子目录里的文件。遇到重名文件会自动变成：

图片.jpg
图片_1.jpg
图片_2.jpg

保存为：整理子目录文件到上级.vbs

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