Unzip with 7-zip in VBA
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 FunctionExample of
ExecCmd
function can be found here.