求助：解压及合并文件夹代码不能运行

999lhg999

各位版主和各位高手，大家好！

    得到了一段代码，想实现下面功能。但这段代码不能运行，恳请大家能指点！谢谢大家！！！
    检查并解压ZIP和RAR文件，然后删除已解压的压缩文件。
    将每个子文件夹中不在根目录中的文件移到根目录，并删除子文件夹中的文件，使子文件夹为空。
    删除已清空的子文件夹。

Sub ProcessFilesInFolder()
    Dim rootFolder As String
    Dim folder As Object
    Dim subFolder As Object
    Dim file As Object
    Dim shell As Object
    Dim fso As Object
    Dim zipFiles As Object
    Dim rarFiles As Object
    Dim cmd As String
    Dim fileName As String
    Dim moveFile As Boolean
   
    ' 设置目标文件夹路径
    rootFolder = "C:\path\to\Mubao"  ' 修改为实际路径
   
    ' 创建文件系统对象和Shell对象
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set shell = CreateObject("WScript.Shell")
   
    ' 检查并处理目标文件夹中的压缩文件
    Set zipFiles = fso.GetFolder(rootFolder).Files
    Call ProcessZipAndRar(zipFiles, fso, shell, rootFolder)
   
    ' 处理子文件夹中的文件
    Call ProcessSubFolders(fso.GetFolder(rootFolder), fso, rootFolder)
   
    ' 删除空子文件夹
    Call DeleteEmptySubFolders(fso.GetFolder(rootFolder), fso)

    MsgBox "处理完成！"
End Sub

Sub ProcessZipAndRar(files As Object, fso As Object, shell As Object, rootFolder As String)
    Dim file As Object
    Dim cmd As String
    For Each file In files
        ' 如果是ZIP文件
        If LCase(fso.GetExtensionName(file.Name)) = "zip" Then
            ' 解压ZIP文件
            cmd = "7z x """ & file.Path & """ -o""" & rootFolder & """"
            shell.Run cmd, 0, True
            ' 删除ZIP文件
            fso.DeleteFile file.Path
        End If
        ' 如果是RAR文件
        If LCase(fso.GetExtensionName(file.Name)) = "rar" Then
            ' 解压RAR文件
            cmd = "7z x """ & file.Path & """ -o""" & rootFolder & """"
            shell.Run cmd, 0, True
            ' 删除RAR文件
            fso.DeleteFile file.Path
        End If
    Next file
End Sub

Sub ProcessSubFolders(folder As Object, fso As Object, rootFolder As String)
    Dim subFolder As Object
    Dim file As Object
    Dim moveFile As Boolean
    For Each subFolder In folder.Subfolders
        For Each file In subFolder.Files
            ' 如果文件不在根目录下
            If Not fso.FileExists(rootFolder & "\" & file.Name) Then
                ' 将文件移动到根目录
                fso.MoveFile file.Path, rootFolder & "\" & file.Name
            Else
                ' 如果文件已存在，则删除子文件夹中的该文件
                fso.DeleteFile file.Path
            End If
        Next file
        ' 删除已清空的子文件夹
        If fso.GetFolder(subFolder.Path).Files.Count = 0 And fso.GetFolder(subFolder.Path).Subfolders.Count = 0 Then
            fso.DeleteFolder subFolder.Path
        End If
    Next subFolder
End Sub

Sub DeleteEmptySubFolders(folder As Object, fso As Object)
    Dim subFolder As Object
    For Each subFolder In folder.Subfolders
        ' 如果子文件夹为空，则删除它
        If fso.GetFolder(subFolder.Path).Files.Count = 0 And fso.GetFolder(subFolder.Path).Subfolders.Count = 0 Then
            fso.DeleteFolder subFolder.Path
        End If
    Next subFolder
End Sub

==============================

shell.Run cmd, 0, True，这里有错，不会修改了

999lhg999

shell.Run cmd, 0, True，这里有问题，不会了！

taller

7z 需要使用全目录，例如 C:\Program Files\7-Zip\7z.exe

perfect131

ai写的？
zip解压不需要第三方

999lhg999

taller 发表于 2025-1-31 14:23
7z 需要使用全目录，例如 C:\Program Files\7-Zip\7z.exe

谢谢，原来是7z存在问题，现在能运行了，但没达到目的。运行后所有的文件都给删除了！

999lhg999

perfect131 发表于 2025-1-31 14:31
ai写的？
zip解压不需要第三方

是的，AI写的

999lhg999

原来是7Z安装存在问题，现在可运行了。但运行后把所有的文件都删除了。没达到目的，各位有测听力的，帮忙修改一啊你！多谢了！

999lhg999

taller

999lhg999 发表于 2025-1-31 15:24
谢谢，原来是7z存在问题，现在能运行了，但没达到目的。运行后所有的文件都给删除了！

单步执行代码，看看是哪里逻辑不对（删除文件）