Extract file . zip Password protected

Question

I am doing a VBA macro in excel, to extract . zip files (which would be a barbada to do), except when the file is protected. I searched everything that is corner, there are several tutorials to extract . zip protected, but none of them is for when the file have password. So I found some tips to use Shell commands (Sorry, but I never used Shell in VBA), so I found the following code, and I can’t :

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
    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
'With this example you browse to the zip or 7z file you want to unzip
'The zip file will be unzipped in a new folder in: Application.DefaultFilePath
'Normal if you have not change it this will be your Documents folder
'The name of the folder that the code create in this folder is the Date/Time
'You can change this folder to this if you want to use a fixed folder:
'NameUnZipFolder = "C:\Users\Ron\TestFolder\"
'Read the comments in the code about the commands/Switches in the ShellStr
'There is no need to change the code before you test it
Sub A_UnZip_Zip_File_Browse()
    Dim PathZipProgram As String, NameUnZipFolder As String
    Dim FileNameZip As Variant, ShellStr As String
    'Path of the Zip program
    PathZipProgram = "C:\program files\7-Zip\"
    If Right(PathZipProgram, 1) <> "\" Then
        PathZipProgram = PathZipProgram & "\"
    End If

    'Check if this is the path where 7z is installed.
    If Dir(PathZipProgram & "7zFM.exe") = "" Then
        MsgBox "Please find your copy of 7z.exe and try again"
        Exit Sub
    End If

    'Create path and name of the normal folder to unzip the files in
    'In this example we use: Application.DefaultFilePath
    'Normal if you have not change it this will be your Documents folder
    'The name of the folder that the code create in this folder is the Date/Time
    NameUnZipFolder = Application.DefaultFilePath & "\TESTE"
    'You can also use a fixed path like
    'NameUnZipFolder = "C:\Users\Ron\TestFolder"

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

    'Unzip the files/folders from the zip file in the NameUnZipFolder folder
    If FileNameZip = False Then
                MsgBox FileNameZip
    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 & "7zFM.exe x -aoa -r" _
                 & " " & Chr(34) & FileNameZip & Chr(34) _
                 & " -o" & Chr(34) & NameUnZipFolder & Chr(34) & " " & "*.*"

        ShellAndWait ShellStr, vbHide
        MsgBox "Look in " & NameUnZipFolder & " for extracted files"
    End If
End Sub

Where it says to include the "-ppassword" failed to do, it does not return. I tried to do it with a file without password, in this same code, and it doesn’t extract, I just didn’t understand why. I put the . exe from 7zip according to my directory, only when it arrives at this extract step, it stops and brings no return. In the case below, "15100086230090" is the password, so it would be -p15100086230090 correct?

    ShellStr = PathZipProgram & "7zFM.exe x -aoa -r -p15100086230090" _
             & " " & Chr(34) & FileNameZip & Chr(34) _
             & " -o" & Chr(34) & NameUnZipFolder & Chr(34) & " " & "*.*"

Answer 1

Use the Ron de Bruin’s sample program, one of the best sites for Excel VBA, along with the Cpearson.

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

Problem

Ron de Bruin asks to use the -ppassword for files with extension .7z, in the case of zip files, use the -p.

So conditional on how to create the ShellStr can be performed, first to check if you need a password or not. And then, with Filesystemobject (FSO), check if the extension is . 7z or . zip, to change the shell command to enter password.

Program Steps

1. Enter the 7-zip path and check if it is correct
2. The directory in which the files will be saved (NameUnZipFolder)
3. Choose the zip file path (FileNameZip)
4. Enter the password (senha)
5. Calls the function ShellAndWait to extract the files

In case the program hangs with infinite loop on ShellAndWait, error is in command Shell Script sent, there is some error in your ShellStr

Code

The code has been changed to work correctly for password programs, 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