restinpiece @ ウィキ zip解凍
※上記の広告は60日以上更新のないWIKIに表示されています。更新することで広告が下部へ移動します。

'#################################################################
' 指定した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