解压缩受密码保护的zip文件并使用Excel VBA解压缩文件

Question

我正在尝试自动解压缩zip文件并将文件解压缩到新的文件夹位置。我搜索了一堆来源并找到了解压缩文件夹的代码，但它实际上没有删除里面的文件并将它们放在新的位置，它只是复制zip文件夹并将其粘贴到新的位置。密码已删除。我希望它提取内部文件，并将它们放在新文件夹中。在此先感谢您的帮助。这是我的代码：

Sub Unzip1()
    Dim FSO As Object
    Dim oApp As Object
    Dim Fname As Variant
    Dim FileNameFolder As Variant
    Dim DefPath As String
    Dim strDate As String

        Dim sPathTo7ZipExe As String
        Dim sZipPassword As String

        sPathTo7ZipExe = "C:\Riley\7Zip\7za.exe"  ' <-- change this to where you installed the 7zip command line program
        sZipPassword = "password"  ' <-- change this to your zip password


    Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
                                        MultiSelect:=False)
    If Fname = False Then
        'Do nothing
    Else
        'Root folder for the new folder.
        'You can also use DefPath = "C:\Users\Ron\test\"
        'DefPath = Application.DefaultFilePath
        DefPath = "C:\Riley\Visual Basic\"  '   <-- make sure your path here ends in a \.  you were missing that before
        If Right(DefPath, 1) <> "\" Then
            DefPath = DefPath & "\"
        End If

        'Create the folder name
        strDate = Format(Now, " dd-mm-yy h-mm-ss")
        FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"

        'Make the normal folder in DefPath
        MkDir FileNameFolder


        Shell sPathTo7ZipExe & " x -y -p" & sZipPassword & " -o""" & _
            FileNameFolder & """ """ & Fname, vbHide

        MsgBox "You find the files here: " & FileNameFolder

        'On Error Resume Next
        'Set FSO = CreateObject("scripting.filesystemobject")
        'FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
    End If
End Sub