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
沒有留言:
張貼留言