Click here to Skip to main content
15,867,594 members
Articles / Programming Languages / Visual Basic 6
Tip/Trick

Unzip with 7-zip in VBA

Rate me:
Please Sign up or sign in to vote.
0.00/5 (No votes)
9 Feb 2010CPOL 40.4K   2  
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)


Written By
Database Developer
United Kingdom United Kingdom
This member has not yet provided a Biography. Assume it's interesting and varied, and probably something to do with programming.

Comments and Discussions

 
-- There are no messages in this forum --