'#################################################################
' 指定したpathのZipを解凍する。
' 第1引数 解凍するzipのURLを指定
' 第2引数 解凍するzipのファイル名を指定
' 第3引数 解凍するzipの作業フォルダを指定
' Unzip32をインストールする必要があります
' http://www.forest.impress.co.jp/lib/arc/archive/arcdll/unzip32.html
'#################################################################
Function ExtractZip(filePath As String, fileName As String, workFilePath As String)
' 指定したpathのZipを解凍する。
' 第1引数 解凍するzipのURLを指定
' 第2引数 解凍するzipのファイル名を指定
' 第3引数 解凍するzipの作業フォルダを指定
' Unzip32をインストールする必要があります
' http://www.forest.impress.co.jp/lib/arc/archive/arcdll/unzip32.html
'#################################################################
Function ExtractZip(filePath As String, fileName As String, workFilePath As String)
'ファイルパスの終端が\じゃない場合、\を追加 If Right(RTrim(filePath), 1) <> "\" Then filePath = filePath + "\" End If 'ファイルパスの終端が\じゃない場合、\を追加 If Right(RTrim(workFilePath), 1) <> "\" Then workFilePath = workFilePath + "\" End If Dim Ret_bool As Boolean 'ZIPファイル Dim Zipfilename As String '解凍オプション Dim Meltopt As String '解凍先ディレクトリ(最後に¥を付けないといけない) Dim Outdir As String 'UnZipのWork Dim Lpstr As String * 5000 'ディレクトリ指定 & 解凍オプション 'Zipfilename = "c:\test.zip" 'Outdir = "c:\Work\" 'ディレクトリ指定 & 解凍オプション Zipfilename = filePath & fileName Outdir = workFilePath Meltopt = "-x " & Zipfilename & " " & Outdir
'書庫の解凍 Ret_bool = UnZip(0, Meltopt, Lpstr, 5000)
If Ret_bool = 0 Then '正常に終了したか 'MsgBox "正常に解凍しました。" Else MsgBox "解凍ファイルをスキップしたか、解凍にエラーがありました" & vbCrLf MsgBox Zipfilename MsgBox Outdir End If
End Function