Click here to Skip to main content
Click here to Skip to main content

Tagged as

Go to top

Unzip with 7-zip in VBA

, 9 Feb 2010
Rate this:
Please Sign up or sign in to vote.
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$) ' <a href="http://www.vbmonster.com/Uwe/Forum.aspx/vb/14063/VB6-and-Shell">See example of ExecCmd.</a>
    ' 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
    '       <a href="http://linux.die.net/man/1/7za">http://linux.die.net/man/1/7za</a>
    '   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.

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Share

About the Author

byapparov
Database Developer
United Kingdom United Kingdom
No Biography provided

Comments and Discussions

 
-- There are no messages in this forum --
| Advertise | Privacy | Mobile
Web01 | 2.8.140916.1 | Last Updated 9 Feb 2010
Article Copyright 2010 by byapparov
Everything else Copyright © CodeProject, 1999-2014
Terms of Service
Layout: fixed | fluid