65.9K
CodeProject is changing. Read more.
Home

Unzip with 7-zip in VBA

emptyStarIconemptyStarIconemptyStarIconemptyStarIconemptyStarIcon

0/5 (0 vote)

Feb 9, 2010

CPOL
viewsIcon

41149

Introduction...

Introduction If you need to unzip files with VBA code then using 7-zip is a good option. You just need to install 7-zip and use UNZIP function from the following code:
Option Compare Database
Option Explicit
Public Const SZIP_APP As String = """C:\Program Files\7-Zip\7z.exe"""

Public Function UNZIP(zipFile$, toFolder$, _
                    Optional PWD$ = vbNullString) As Boolean

    On Error GoTo Err
    
    ' ---------------- Check Parameters ---------------------------
    
    If Not FileExists(zipFile$) Then
        UNZIP = False ' Might want to log this
        Exit Function
    End If
    
    If Not FolderExists(toFolder$) Then
        UNZIP = False ' Might want to log this
        Exit Function
    End If
    ' Check that destination folder is empty
    ' Remove this check if irrelevant
    If Not EmptyFolder(toFolder$) Then 
        UNZIP = False ' Might want to log this
        Exit Function
    End If
  
    If Not FileExists(replace(SZIP_APP, """", vbNullString)) Then
        UNZIP = False ' Might want to log this
        Exit Function
    End If
    '--------------------------------------------------------------
    '                      Run Command Line
    '--------------------------------------------------------------
    
    Dim cmd$
    cmd$ = SZIP_APP & " e " & zipFile & " -o" & toFolder
    If PWD$ <> vbNullString Then cmd$ = cmd$ & " -p" & PWD$
    Dim res As Long
    res = ExecCmd(cmd$) ' See example of ExecCmd.
    ' Check exit code (error level)
    If Not res = > 1 Then
        UNZIP = False ' Might want to log this using ZipErrorDesc()
        Exit Function
    End If
    
    UNZIP = True
    
    Exit Function
Err:
    UNZIP = False
    ' Add Error Logging Here
End Function

Public Function ZipErrorDesc(Code As Long) As String
' Check the 7-zip exit codes
    '   See
    '       http://linux.die.net/man/1/7za
    '   for details
    Dim errDesc$
    Select Case Code
        Case 0
            errDesc$ = ""
        Case 1
            errDesc$ = "Warning (Non fatal error(s))." & _
   " For example, some files cannot be read during compressing." &_
   " So they were not compressed"
        Case 2
            errDesc$ = "Fatal error"
        Case 7
            errDesc$ = "Bad command line parameters"
        Case 8
            errDesc$ = "Not enough memory for operation"
        Case 255
            errDesc$ = "User stopped the process with control-C" & _
                       "(or similar)"
        Case Else
            errDesc$ = "Unknown exit code"
    End Select
    
    ZipErrorDesc = errDesc$
    
End Function
' *******************************************************************
Function FolderExists(strPath As String) As Boolean
    On Error Resume Next
    FolderExists = ((GetAttr(strPath) And vbDirectory) = vbDirectory)
End Function
Public Function EmptyFolder(strPath As String) As Boolean
    EmptyFolder = (Dir(strPath & "\*.*") = "")
End Function
Public Function FileExists(File$) As Boolean
    FileExists = (Not LenB(Dir(File$)) = 0)
End Function
Example of ExecCmd function can be found here.