Как распаковать список файлов .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