如何解压缩.zip文件列表并重命名每个文件的内容

Question

嗨，我需要将目录中的zip文件列表解压缩并将其放在目标文件夹中。但是，我需要按数字顺序重命名它解压缩的每个文件-字面上将其命名为1、2、3、4、5、6，依此类推...

这是我到目前为止所拥有的：

Sub UnzipFiles()
Dim myfolder
Dim destfolder


With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    myfolder = .SelectedItems(1) & "\"
End With

With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    destfolder = .SelectedItems(1) & "\"
End With

Call Recursive(myfolder, destfolder)

End Sub

Sub Recursive(FolderPath As Variant, destfolder As Variant)
Dim Value As String, Folders() As String
Dim Folder As Variant, a As Long
Dim SApp As Object

ReDim Folders(0)

If Right(FolderPath, 2) = "\\" Then Exit Sub
Value = Dir(FolderPath, &H1F)


Do Until Value = ""
    If Value = "." Or Value = ".." Then
    Else
        If GetAttr(FolderPath & Value) = 16 Or GetAttr(FolderPath & Value) = 48 Then
            Folders(UBound(Folders)) = Value
            ReDim Preserve Folders(UBound(Folders) + 1)
        Else
            If Right(Value, 4) = ".zip" Then
                Set SApp = CreateObject("Shell.Application")
                SApp.Namespace(destfolder).CopyHere _
                SApp.Namespace(FolderPath & Value).items
            End If
        End If
    End If
    Value = Dir
Loop

For Each Folder In Folders
    Call Recursive(FolderPath & Folder & "\", destfolder)
Next Folder

End Sub