「zip解凍」の編集履歴（バックアップ）一覧はこちら

「zip解凍」(2008/09/11 (木) 18:27:59) の最新版変更点

追加された行は緑色になります。

削除された行は赤色になります。

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