Translate

2013年6月9日 星期日

[VBA] Unzip a File and Files in a folder

I used to try to find methods within VBA to unzip files, but the result was failed.
So I have to do the extraction by an external command line program, 7zip is used here.

Below is the url for the command line version of 7 zip.


1. ShellAndWait is not a standard method in VBA, pls find it in this url, http://waltertech426.blogspot.hk/2013/06/vba-do-shell-command-and-wait-it-finishs.html.

2. ZipTool_local_path is a global constant which define the relative location of the 7zip command line program,
e.g. \7za\7za

Public Function ExtractZipInDir(SrcDir As String, DesDir As String, Optional Criteria As String = "", Optional DeleteZipFile As Boolean = False) As String
    On Error GoTo Err_ExtractZip
    
    Dim FailedReason As String
    
    Dim Result As String
    
    Criteria = SrcDir & Criteria
    Result = Dir(Criteria)
    
    
    Do While Len(Result) > 0
        Call ExtractZip(SrcDir & Result, DesDir, DeleteZipFile)
        Result = Dir
    Loop

Exit_ExtractZip:
    ExtractZipInDir = FailedReason
    Exit Function

Err_ExtractZip:
    Call ShowMsgBox(Err.Description)
    Resume Exit_ExtractZip

End Function

Public Function ExtractZip(Src As String, DesDir As String, Optional DeleteZipFile As Boolean = False) As String
    On Error GoTo Err_ExtractZip
    
    Dim FailedReason As String
    
    Dim ZipTool_path As String
    ZipTool_path = [CurrentProject].[Path] & ZipTool_local_path
    
    Dim ShellCmd As String
    Dim Success As Boolean

    
    ShellCmd = ZipTool_path & " x " & Src & " -o" & DesDir & " -ry"
    'MsgBox ShellCmd
    Success = ShellAndWait(ShellCmd, vbHide)

    If Success = True And DeleteZipFile = True Then
        Kill Src
    End If

Exit_ExtractZip:
    ExtractZip = FailedReason
    Exit Function

Err_ExtractZip:
    Call ShowMsgBox(Err.Description)
    Resume Exit_ExtractZip

End Function 

沒有留言:

張貼留言