【ExcelVBA】ZIPファイルの解凍をまとめて連続実行させる

スポンサーリンク

前回記事でZIPファイルの作成方法を紹介した際に、複数(大量)のZIPファイルをまとめて解凍することは次の機会に紹介したいとしていましたのでさっそく実行します
実は、仕事でメール報告を受けたのですが、ファイルのサイズが大きいためZIPファイルに圧縮されて来たんです。その件数が約800件!

くるみこ
くるみこ

1件や2件ならいいけど。。。
   はっはっ800件って(@_@。。。  なんとかしてョ~(-_-;) 
 

ということで、何とかしてみましょう(^^)/
前回記事で使ったファイルに解凍機能をチョコっとつければ解決です。VBAに解凍部分のコードを追加して利用します。

・ZIPファイルの作成(圧縮)方法については前回記事を参照してください▼

VBAから7-zip32.dllを使って大量のZIPファイルを一括で解凍する方法を解説します

スポンサーリンク

ZIPファイルの解凍ロジックを確認

フローチャートで確認

圧縮のフローチャートを解凍用に変更しています

解凍先に同名のファイルが存在する場合の処理をどうするかが一番重要なところですね

ZIP作成実行に用意するシートは1つ

「ZIPファイル作成」シート

・画像を用意しましたので確認してください

前回記事で作成したシートをコピーして加工しています

・各ボタンの文字列を「解凍用」に修正変更しています
・OPTIONスイッチを変更するためのプルダウンセルを2つ設置
「$I$9」セルに同名の既存ファイルがあった場合の処理を変更できるようプルダウン
 選択を設定しています(画像には参考にスイッチ表を貼り付けています)
「$I$11」セルに「7-zipの処理状況ダイアログ」を表示するかどうか選択できるように
 プルダウン選択を設定圧縮用のZIP作成シートもついでにこの部分を変更しました

シート作成が面倒ならば、サンプルファイルを用意していますので、ダウンロードページへのリンクからからDLしてください

ZIPファイルを解凍する方法

・それでは、前回のVBAコードに追加するコードを紹介します

ZIPファイル解凍に必要なコードの追加

'ZIPファイルを解凍
'引数 szUnzipPath:解凍先のフォルダーのパス
'     szZIPName:ZIPファイルのパス
'     szPWord:パスワード 省略可
'返り値 成功したら True、失敗したらFalse
Public Function DeCompUNZIP(szUnzipPath As String, szZIPName As String, _
                        Optional szPWord As String = "") As Boolean
    Dim szCmd As String
    szCmd = "X " & Cells(11, 9) & " " & Cells(9, 9) & " "
    'szCmd = "X -hide -aoa " '全てのファイルを確認しないで上書き
    'szCmd = "X -hide -aos " '既存のファイルはスキップ
    'szCmd = "X -hide -aou " '解凍するファイルを自動的にリネーム
    'szCmd = "X -hide -aot " '既存のファイルを自動的にリネーム
    If szPWord <> "" Then szCmd = szCmd & "-P" & szPWord & " "
    szCmd = szCmd & dq(szZIPName) & " -o" & dq(szUnzipPath)
    DeCompUNZIP = DoSevenZIP(szCmd) = 0
End Function

・10~13行目に、それぞれの動作設定オプションスイッチをコメント表示しています
9行目で、そのオプションスイッチをシートのセルデータから参照して設定する
 方法で記述しています(今回はこの方法を採用しています)

「解凍先フォルダ」の参照ボタンから実行するコード

・これの説明は、単にフォルダを選択指定してセルにセットしているだけですね

'*******************************************
'* 解凍先フォルダ選択指定
'*******************************************
Sub CmdSetFolder()
    Dim n As Long
    Dim re As Long
    
    '「フォルダ選択」ダイアログを表示(modFolderPicker1)
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "解凍先フォルダの参照"
        .AllowMultiSelect = False
        If .Show = False Then
            MsgBox "選択されませんでした"
            Exct Sub
        End If
        'フォルダパスをセルにセット
        Cells(2, 9).Value = .SelectedItems(1)
    End With
End Sub

ZIPファイルの解凍を開始させるコード

・「解凍処理開始」ボタンから実行するコードです

'*******************************************
'* ZIPファイル解凍実行
'*******************************************
Sub CmdUnZip()
    Dim lngRow As Long          '開始行
    Dim lngRowMax As Long       '最終行
    Dim i As Long               '行指定用
    Dim strFoldFiles As String  '解凍対象フォルダ&ファイル名用
    Dim strDstFullPath As String 'ZIPのフルパス
    Dim strZipName As String    '解凍履歴.txtファイル名用
    Dim strPW As String         'パスワード
    Dim strApndRep As String    '追加or置換
    Dim strErr As String        'エラーメッセージ
    Dim objFSO As FileSystemObject  'FileSystemObject
    Set objFSO = New FileSystemObject
    
    '7-Zip.dllのパス設定(Systmに無い場合のため)
    ChDrive ThisWorkbook.path
    ChDir ThisWorkbook.path
    
    lngRowMax = Cells(Rows.Count, 2).End(xlUp).Row '対象データ最終行
    lngRow = 2  'データ開始行
        
    '解凍先フォルダパス
    strDstFullPath = Trim(Cells(2, 9).Value)
    strZipName = "解凍履歴"
    '追加or置換判定(置換の場合ZIPファイルを削除)
    strApndRep = Cells(5, 9).Value
    If strApndRep = "置換" Then
        On Error Resume Next
        objFSO.DeleteFile strDstFullPath & "\*", True
        objFSO.DeleteFolder strDstFullPath & "\*", True
        If Err.Number <> 0 Then
            strErr = "解凍先フォルダ内ファイル等の事前削除に失敗!" _
                        & vbCrLf & Err.Description
            Err.Clear
            On Error GoTo 0
            Set objFSO = Nothing
            Exit Sub
        End If
        On Error GoTo 0
    End If
    'ログ用txtファイル見出し
    strcmd = "cmd sw1 sw2 sw3 PW ZIPファイル名 Path/FileName"
    '解凍対象数分のループ処理
    For i = lngRow To lngRowMax
        '対象フォルダ&ZIPファイルの存在確認
        strFoldFiles = Trim(Cells(i, 2).Value)
        If Not objFSO.FileExists(strFoldFiles) Then
            If objFSO.FolderExists(strFoldFiles) Then
                'フォルダ指定はフォルダ内の全てのZIPを
                strFoldFiles = strFoldFiles & "\*.zip"
            Else
                strErr = "対象が存在しません。" _
                                & vbCrLf & strFoldFiles
                Set objFSO = Nothing
                Exit Sub
            End If
        End If
        'パスワード(個別設定を優先する)
        strPW = Trim(Cells(i, 7).Value)
        If strPW = "" Then strPW = Trim(Cells(7, 9).Value)
        '-------------------------------------------
        '7-Zip.dllの処理へ(解凍先フォルダ、ZIPファイル、PW)
        Call DeCompUNZIP(strDstFullPath, strFoldFiles, strPW)
        '-------------------------------------------
    Next
    '解凍実行後ログをテキストファイルに書き出す
    Dim strPath As String
    strPath = strDstFullPath & strZipName & ".txt"
    strcmd = strcmd & vbCrLf & "解凍処理日時:" & Now
    With objFSO
        If Not .FileExists(strPath) Then
            .CreateTextFile (strPath)
        End If
        With .OpenTextFile(strPath, 8) '8:ForAppending
            .WriteLine strcmd
            .Close
        End With
    End With
    Set objFSO = Nothing
    MsgBox "ZIPファイルの解凍処理が完了しました!" & vbCrLf & _
            "復元したファイルを確認してください。"
End Sub

・65行目「Call DeCompUNZIP(strDstFullPath, strFoldFiles, strPW)」で7-Zip.dllに処理を行わせる関数を呼び出しています
・71行目「strcmd = strcmd & vbCrLf & “解凍処理日時:” & Now」でログ書き出し前に解凍処理日時(Now)を追記しています(これについては、ログに次の処理状況も追加で書き込まれるていくため、追記するように変更しました。ZIP作成部分のコードにも同様にこの部分を追記しています)

ZIPファイルの解凍コマンドオプションの検証

-ao : 上書きモード(解凍時、既にファイルが存在した時の動作を設定します)
構文: -ao[a | s | t | u ](-aoに続けて [a] [s] [t] [u] などのスイッチを指定します)
【それぞれの動作モードは次のとおりです】
 -aoa全てのファイルを確認しないで上書きします これを使うのは少し危険ですね
 -aos:既存のファイルはスキップします
 -aou解凍するファイルを自動的にリネームします
 -aot既存のファイルを自動的にリネームします
 (リネーム例: name.txt は name_1.txt に、name.txt と name_1.txt がある場合は  
         name_2.txt のように数字+1 追加されます)
 指定のない場合、都度上書き確認ダイアログが表示されます必ず指定しないと大変

【注意】動作確認する場合は、バックアップを取ってから実行しましょう!

 -hide:これを指定すると処理状況ダイアログを表示しません
 指定しなければ:解凍処理状況をプログレスバー付のダイアログで表示してくれます
 速度は若干遅くなるかもしれませんが、表示しておいた方が精神的に良いのでは?

私自身が使った設定は、
-aou:解凍するファイルを自動的にリネームします
-hide:は指定しないで解凍処理状況のプログレスバーを表示するようにしています
設定を色々変えて動作確認して、自分に合った設定を見つけてみてください

まとめ(おわりに)

基本事項の再確認と補足・感想など

統合アーカイバから7-ZIP32.DLL for windows 32bitsをダウンロードしてください
・是非、前回記事とあわせてご覧ください
・今回の記事のサンプルファイルには前回記事の「ZIP作成(圧縮)」も入っています

・複数(大量)のZIPファイルをまとめて解凍することはあまりないかもしれませんが
単独のZIPファイルの解凍にも使えますのでご利用ください

今後の記事について

今回の記事はいかがだったでしょうか。お役に立てたなら幸いです(^^;
是非!サンプルがありますので使ってみてください(^^)/

【今後の記事内容はどうしようかなぁ・・・】
・高速化した「VlookUp関数」のVBAでの活用法を再検討してみたいと思います
・その他「小ネタいろいろ」などなど・・・・・
・今後これらのどれかについて記事にしていきたいと思います。ご期待ください(^^)/

サンプルファイルをダウンロードできます(下記リンク先へ)

記事で使用したサンプルファイルがダウンロードできるページを設置しています
こちら(このリンク先)からご利用ください