Extract file.password protected zip

Use the Ron De Bruin example program, one of the best sites for Excel VBA, along with the Cpearson .

This program uses the Windows Shell and to unpack, it uses the 7-Zip, in which the installation path of the program must be informed. But if it was installed in default mode, it will normally be in "C:\program files \ 7-Zip\".

Problem

Ron De Bruin asks to use -ppassword for files with extension .7z, for zip files, use -p.

Then conditionals of how to create the ShellStr can be carried out, first to check whether it needs password or not. And then, with the FileSystemObject(FSO), check if the extension is .7z or .zip, to change the password input in the shell command.

Program steps

1. inserts the path of the 7-zip and check if it is correct
2. the directory in which the files will be saved (NameUnZipFolder)
3. choose the path from the zip file(FileNameZip)
4. Enter Password (senha)
5. calls the function ShellAndWait to extract the files

In case the program crashes with infinite loop in ShellAndWait, the error is in the command Shell script sent, there is some error in its ShellStr

Code

The code has been changed to work correctly for programs with password, in which the program must be chosen.

' Declaração com compatibilidade entre 64 e 32 bits
#If VBA7 Then
    Private Declare PtrSafe Function OpenProcess Lib "kernel32" _
        (ByVal dwDesiredAccess As Long, _
        ByVal bInheritHandle As Long, _
        ByVal dwProcessId As Long) As Long

    Private Declare PtrSafe Function GetExitCodeProcess Lib "kernel32" _
        (ByVal hProcess As Long, _
        lpExitCode As Long) As Long
#Else
    Private Declare Function OpenProcess Lib "kernel32" _
        (ByVal dwDesiredAccess As Long, _
        ByVal bInheritHandle As Long, _
        ByVal dwProcessId As Long) As Long

    Private Declare Function GetExitCodeProcess Lib "kernel32" _
        (ByVal hProcess As Long, _
        lpExitCode As Long) As Long
#End If


Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103


Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState)
    Dim hProg As Long
    Dim hProcess As Long, ExitCode As Long
    'fill in the missing parameter and execute the program
    'preenche o parâmetro que falta e executa o programa
    If IsMissing(WindowState) Then WindowState = 1
    hProg = Shell(PathName, WindowState)
    'hProg is a "process ID under Win32. To get the process handle:
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
    Do
        'populate Exitcode variable
        GetExitCodeProcess hProcess, ExitCode
        DoEvents
    Loop While ExitCode = STILL_ACTIVE
End Sub

Sub A_UnZip_Zip_File_Browse()
    Dim PathZipProgram As String, NameUnZipFolder As String
    Dim FileNameZip As Variant, ShellStr As String, senha As String

    'Caminho do programa zip, neste caso o 7-Zip
    PathZipProgram = "C:\program files\7-Zip\"
    If Right(PathZipProgram, 1) <> "\" Then
        PathZipProgram = PathZipProgram & "\"
    End If

    'Verifica se o 7-Zip está realmente instalado neste diretório
    If Dir(PathZipProgram & "7z.exe") = "" Then
        MsgBox "Por favor encontre a sua cópia do 7z.exe e tente novamente"
        Exit Sub
    End If

    'Cria uma pasta no diretório padrão "Documentos", com a data e hora
    NameUnZipFolder = Application.DefaultFilePath & "\" & Format(Now, "yyyy-mm-dd h-mm-ss")
    'Caso deseje alterar a pasta em que o arquivo será descompactado, altere o caminho para:
    'NameUnZipFolder = "C:\Users\PastaDesejada\TestFolder"

    'Selecione o arquivo zip (.zip ou .7z)
    FileNameZip = Application.GetOpenFilename(filefilter:="Zip Files, *.zip, 7z Files, *.7z", _
                                              MultiSelect:=False, Title:="Select the file that you want to unzip")

    'Senha
    senha = "suasenha"

    'Unzip
    If FileNameZip = False Then
        'do nothing
    Else
        'There are a few commands/Switches that you can change in the ShellStr
        'We use x command now to keep the folder stucture, replace it with e if you want only the files
        '-aoa Overwrite All existing files without prompt.
        '-aos Skip extracting of existing files.
        '-aou aUto rename extracting file (for example, name.txt will be renamed to name_1.txt).
        '-aot auto rename existing file (for example, name.txt will be renamed to name_1.txt).
        'Use -r if you also want to unzip the subfolders from the zip file
        'You can add -ppassword if you want to unzip a zip file with password (only 7zip files)
        'Change "*.*" to for example "*.txt" if you only want to unzip the txt files
        'Use "*.xl*" for all Excel files: xls, xlsx, xlsm, xlsb
        ShellStr = PathZipProgram & "7z.exe x -aoa -r" _
                 & " " & adiciona_aspas(FileNameZip) _
                 & " -p" & adiciona_aspas(senha) _
                 & " -o" & adiciona_aspas(NameUnZipFolder) & " " & "*.*"
        'Se não possuir senha, exclua a linha de senha '& " -p" & adiciona_aspas(senha) _'
        'Então você pode criar condicionais para verificar se possui ou não senha.

        ShellAndWait ShellStr, vbHide
        MsgBox "Procure os arquivos extraídos em " & NameUnZipFolder

    End If
End Sub

Function adiciona_aspas(str) As String
    adiciona_aspas = Chr(34) & str & Chr(34)
End Function