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.