Unzipping a password protected zip file and extracting files using Excel VBA

Question

I am trying to automate unzipping a zip file and extracting the files to a new folder location. I have scoured a bunch of sources and found code that will unzip the folder but it won't actually remove the files inside and put them in the new location, it just copies the zip folder and pastes it to the new location with the password removed. I want it to extract the files inside, and place them in the new folder. Thanks in advance for any help. Here is my code:

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