2020.07.26

《ブログリレー＃6》VBAでフォルダの圧縮・ZIPの解凍をまとめて行う

最近Unityを勉強中の「システム開発事業部」工藤です！
さて今回は、制作ブログ兼、ブログリレー第6弾と称し「複数のフォルダの圧縮、ファイルをまとめて解凍するプログラム」を紹介します。

圧縮、解凍したいファイルが少ない場合は右クリックからでも手間はかかりませんが、複数あった場合は時間も手間もかかってしまうと思います。
今回はそんな時にあると便利なプログラム（VBA）を紹介します。

1 圧縮・解凍の流れ
2 サンプルの使い方
3 サンプルプログラムの説明
4 まとめ

圧縮・解凍の流れ

今回はローカルフォルダ内のフォルダ、またはZIPファイルに対して処理を行うので

対象となるフォルダパスを指定
押下されたボタンを判別し、圧縮、解凍を選択
対象となるフォルダ内の、フォルダの圧縮、またはZIPの解凍

という流れになります。

サンプルの使い方

サンプルファイルのダウンロード

上記リンクからZIPファイルをダンロードして解凍します。
エクセル（zip.xlsm）を開きます。
マクロを有効にします。
「対象フォルダPATH」を記入します。（必須）
- 圧縮・解凍処理を行いたいフォルダ、またはZIPファイルの入った対象フォルダを指定します。
- ※ フォルダ名に半角スペースが入っている場合、正常に動作しません。
「圧縮」または「解凍」ボタンを押下します。
「PowerShell」が立ち上がり、圧縮、または解凍を行います。
「PowerShell」が立ち上がらなくなり、メッセージボックスが表示されます。
指定したフォルダに圧縮、または解凍されていれば完了です。

完了のメッセージBOXが表示されます。

指定したフォルダに圧縮されたZIPファイル、または解凍されたフォルダが保存されます。

サンプルプログラムの説明

動作確認環境

Windows10
Excel2019

参照設定

今回は「PowerShell」から圧縮、解凍を行うので以下の参照設定を追加します。

デフォルト参照設定

Visual Basic For Applications
Microsoft Excel **.* Object Library
OLE Automation
Microsoft Office **.* Object Library

追加参照設定

Windows Script Host Object Model

参照にチェックを入れ「OK」を押すと参照が追加されます。

サンプル

サンプルファイルのダウンロード
zip モジュール

''' 参照追加
'''     Windows Script Host Object Model
'''

Option Explicit

Sub main()

'
' PATH 設定
'
Dim str_path As String

' PATH 取得
With ActiveSheet
    str_path = .Range("B5").Value
End With

' PATH 設定確認
If "" = str_path Then
    MsgBox ("対象パスを入力してください。")
    Exit Sub
End If

'
' 実行処理 設定
'
Dim str_button As String
    ' 押下ボタン取得
    str_button = Application.Caller
Dim str_method As String
    ' ボタンで 圧縮 解凍 切り替え
    str_method = IIf(str_button = "圧縮", "Compress-Archive", "Expand-Archive")

'
' 処理開始
'
Dim obj_folder As Object
Dim obj_target As Object
Dim obj_ws As New IWshRuntimeLibrary.WshShell
Dim obj_we As WshExec
Dim str_cmd As String
Dim str_before As String
Dim str_after As String
Dim str_result As String
    str_result = ""

' フォルダ内 取得
With CreateObject("Scripting.FileSystemObject")

    ' 各フォルダ
    Set obj_target = IIf(str_button = "圧縮", .GetFolder(str_path).SubFolders, .GetFolder(str_path).Files)
    For Each obj_folder In obj_target

        ' 処理の分岐 + スペースをエスケープ
        If str_button = "圧縮" Then
            ' 圧縮時
            str_before = Replace(obj_folder.Path, " ", "` ")
            str_after = str_path & Replace(obj_folder.Name, " ", "` ") & ".zip"
        Else
            ' 解凍時
            If InStr(obj_folder.Path, ".zip") = 0 Then
                ' .zip が含まれていない場合 処理をスキップ
                GoTo Continue
            End If
            str_before = Replace(obj_folder.Path, " ", "` ")
            str_after = Replace(Replace(obj_folder.Path, " ", "` "), ".zip", "")
        End If

        ' 圧縮コマンド
        str_cmd = "powershell -ExecutionPolicy RemoteSigned -Command " & str_method & " -Path " & str_before & _
            " -DestinationPath " & str_after & " -Force"
        ' コマンド 実行
        Set obj_we = obj_ws.Exec(str_cmd)

        ' 完了 待機
        Do While True
            If obj_we.Status <> WshRunning Then
                ' 結果
                If obj_we.Status = WshFinished Then
                    ' 成功
                    str_result = str_result & obj_folder.Name & " " & str_button & "に成功しました。" & vbCrLf
                ElseIf obj_we.Status = WshFailed Then
                    ' 失敗
                    str_result = str_result & obj_folder.Name & " " & str_button & "に失敗しました。" & vbCrLf
                End If
                Exit Do
            End If
            DoEvents
        Loop

        ' 初期化
        Set obj_we = Nothing

' .zip が含まれていない場合 処理をスキップ先
Continue:
    Next obj_folder
    ' 初期化
    Set obj_target = Nothing

End With

MsgBox (str_result)

End Sub

プログラムの説明

ocr モジュール

' PATH 取得
With ActiveSheet
    str_path = .Range("B5").Value
End With

' PATH 設定確認
If "" = str_path Then
    MsgBox ("対象パスを入力してください。")
    Exit Sub
End If

入力されている値を確認します。
「対象フォルダPATH」は空欄禁止。

Dim str_button As String
    ' 押下ボタン取得
    str_button = Application.Caller
Dim str_method As String
    ' ボタンで 圧縮 解凍 切り替え
    str_method = IIf(str_button = "圧縮", "Compress-Archive", "Expand-Archive")

押下されたボタンの種類を判別し、それぞれのコマンドを指定します。

**圧縮・解凍**コマンド
Compress-Archive	圧縮コマンド
Expand-Archive	解凍コマンド

Dim obj_ws As New IWshRuntimeLibrary.WshShell
Dim obj_we As WshExec

「PowerShell」を使用する際の宣言を行います。

' フォルダ内 取得
With CreateObject("Scripting.FileSystemObject")

    ' 各フォルダ
    Set obj_target = IIf(str_button = "圧縮", .GetFolder(str_path).SubFolders, .GetFolder(str_path).Files)
    For Each obj_folder In obj_target

        ' 処理の分岐 + スペースをエスケープ
        If str_button = "圧縮" Then
            ' 圧縮時
            str_before = Replace(obj_folder.Path, " ", "` ")
            str_after = str_path & Replace(obj_folder.Name, " ", "` ") & ".zip"
        Else
            ' 解凍時
            If InStr(obj_folder.Path, ".zip") = 0 Then
                ' .zip が含まれていない場合 処理をスキップ
                GoTo Continue
            End If
            str_before = Replace(obj_folder.Path, " ", "` ")
            str_after = Replace(Replace(obj_folder.Path, " ", "` "), ".zip", "")
        End If

FileSystemObjectオブジェクトを利用し、対象フォルダ内の「フォルダ」または「ZIPファイル」に対して処理を行います。
「圧縮」が押下された場合は「SubFolders」フォルダーに対して
「解凍」が押下された場合は「Files」ファイルに対して
処理を行うよう分岐します。

※１「解凍」が押下された場合、全てのファイルが対象となってしまうため、ファイルパスに「.zip」が含まれていない場合は、処理をスキップします。

' 圧縮コマンド
str_cmd = "powershell -ExecutionPolicy RemoteSigned -Command " & str_method & " -Path " & str_before & _
    " -DestinationPath " & str_after & " -Force"
' コマンド 実行
Set obj_we = obj_ws.Exec(str_cmd)

「PowerShell」で実行するコマンドを生成し、実行します。
圧縮または解凍
「powershell -ExecutionPolicy RemoteSigned -Command “圧縮または解凍” -Path “対象” -DestinationPath “結果” -Force」

' 完了 待機
Do While True
    If obj_we.Status <> WshRunning Then
        ' 結果
        If obj_we.Status = WshFinished Then
            ' 成功
            str_result = str_result & obj_folder.Name & " " & str_button & "に成功しました。" & vbCrLf
        ElseIf obj_we.Status = WshFailed Then
            ' 失敗
            str_result = str_result & obj_folder.Name & " " & str_button & "に失敗しました。" & vbCrLf
        End If
        Exit Do
    End If
    DoEvents
Loop

処理が完了するまでの待機と、完了後、処理が成功したか、失敗したかの判定を行います。

**Status**
WshRunning	処理中
WshFinished	成功
WshFailed	失敗

処理結果は「str_result」に追記していきます。

        ' 初期化
        Set obj_we = Nothing

' .zip が含まれていない場合 処理をスキップ先
Continue:
    Next obj_folder
    ' 初期化
    Set obj_target = Nothing

それぞれ、仕様Objectの初期化と、「※１」で処理をスキップした際のスキップ先を指定します。

MsgBox (str_result)

最後に結果を追記した文字列を表示して完了です。

まとめ

サンプルファイルのダウンロード
今回は複数のフォルダの圧縮、ファイルをまとめて解凍する方法について、サンプルをもとに解説しました。

今回のサンプルでは、「PowerShell」を利用し、圧縮・解凍を行いましたが、その他にも「外部アプリ」を利用する方法や、「WshShell.NameSpace.CopyHere」を利用する方法などがあります。
「外部アプリ」を利用した場合は、ZIPだけでなく、他の圧縮にも対応することが出来るので、用途によって使い分けてみても良いかもしれません。
※ 本プログラムを利用しために被る損害について、当社に故意または重大な過失がある場合を除き、当社は一切その責任を負いません。

プログラムの開発、お見積り、お問い合わせは、こちらから、ご連絡ください。
まだ仕様の決まっていない場合のご相談などもお気軽にご相談ください。

blog スタッフブログ