vbanavbarvba7vba6

How do I Unzip a 7z zip file using VBA


I have a 7z .zip file I am trying to unzip with VBA. I have attempted several methods but to no avail. See below the zip file type just to be sure where the problem could be from: Image of 7z file

I try the below code, it runs, downloads every attachment but does not unzip the zip file.

Dim ValidExtensions As Collection
Set ValidExtensions = New Collection

ValidExtensions.Add "csv"
ValidExtensions.Add "txt"
ValidExtensions.Add "xls"
ValidExtensions.Add "7z"
ValidExtensions.Add "zip"

Debug.Print "Checking attachments"

For Each objAttachment In objItem.Attachments
    Debug.Print "Found attachment: " & objAttachment.fileName

    Dim extension As String
    extension = LCase(Split(objAttachment.fileName, ".")(UBound(Split(objAttachment.fileName, "."))))
    Debug.Print "Extension: " & extension

    Dim isValidExtension As Boolean
    isValidExtension = False

    Dim validExtension As Variant
    For Each validExtension In ValidExtensions
        If extension = validExtension Then
            isValidExtension = True
            Debug.Print "Valid extension found"
            Exit For
        End If
    Next validExtension

    If isValidExtension Then
        Dim savedFilePath As String
        savedFilePath = monthFolder & "\" & objAttachment.fileName
        Debug.Print "Saving file to: " & savedFilePath
        objAttachment.SaveAsFile savedFilePath
        If extension = "7z" Then
            Debug.Print "7z file found, attempting to unzip"
            Dim pathTo7Zip As String
            pathTo7Zip = "C:\Program Files\7-Zip\7zFM.exe
            Dim command As String
            command = """" & pathTo7Zip & """ e """ & savedFilePath & """ -o""" & monthFolder & """ -y"
            Debug.Print "Running command: " & command
     
            Call shell(command)
        End If
    End If
Next objAttachment

In the immediate window, I get the below details,

Checking attachments
Found attachment: image001.jpg
Extension: jpg
Found attachment: mon_PROD.csv
Extension: csv
Valid extension found
Saving file to: C:\Users\Desktop\\mon_PROD.csv
Checking attachments
Found attachment: ZIP_mon_PROD.zip
Extension: zipChecking attachments
Found attachment: image001.jpg
Extension: jpg
Found attachment: mon_PROD.csv
Extension: csv
Valid extension found
Saving file to: C:\Users\Desktop\\mon_PROD.csv
Checking attachments
Found attachment: mon_PROD.zip
Extension: zip
Valid extension found
Saving file to: C:\Users\Desktop\\mon_PROD.zip
Valid extension found
Saving file to: C:\Users\Desktop\\mon_PROD.zip

I have been on this for hours and no headways. Kindly assist.

Thanks.


Solution

  • Quoting commands isn't hard but also can be a pain so he following might help, its a little like printf in other languages.

    It takes a template string and substitutes values, and replaces &quote; with the quotes.

    Function CommandBuild(ParamArray args() As Variant) As String
    If IsMissing(args) Then CommandBuild = vbNullString: Exit Function
    
    Dim Result As String
    Dim Index As Integer
    Dim UB As Integer: UB = UBound(args)
    Dim Count As Integer: Count = UB - LBound(args)
    
    Result = args(0)
    
    If Count > 0 Then
        For Index = 1 To UB
            Result = Replace(Result, "{" & (Index - 1) & "}", args(Index))
        Next
    End If
    
    CommandBuild = Replace(Result, "&quote;", Chr(34))
    
    End Function
    
    Sub Example()
    
    Dim pathTo7Zip As String: pathTo7Zip = "C:\Program Files\7-Zip\7z.exe"
    Dim saveFilePath As String: saveFilePath = "C:\Users\Desktop\Month\file.7z"
    Dim monthFolder As String: monthFolder = "C:\Users\Desktop\Month"
    
    Debug.Print CommandBuild("&quote;{0}&quote; e &quote;{1}&quote; -o &quote;{2}&quote; -y", pathTo7Zip, saveFilePath, monthFolder)
    
    End Sub