VBAでZIP圧縮と解凍を行う方法【PowerShell活用】

VBAでZIP圧縮と解凍を行う方法

ExcelのVBAで作成したファイルをZIPでまとめたい、あるいは受け取ったZIPを自動で展開したい、こうした「圧縮・解凍を自動化したい」ニーズは多いものです。

しかし、VBAの標準機能にはZIPファイル関連の機能がありません。

無いのであればなんらかの別の方法で行うことになります。具体的には以下が挙げられます。

PowerShellの圧縮、解凍コマンドを利用する。
7-Zipなどの外部ライブラリを利用する。（7-Zipを利用する方法は「VBAで7-Zipでの圧縮と解凍を行う方法」をご参照ください）
他のプログラミング言語のZIP関連機能を利用する。
WshShell.NameSpace.CopyHereメソッドでのZipファイルへのコピー処理を利用する。ただし、Microsoft非推奨（公式リンク）。

どれも一長一短がありますが、より多くのPCで一番確実に動作するのはPowerShellでの方法です。Windows 7以降なら標準搭載されており、管理者権限も不要です。パスワードなしの単純な圧縮と解凍であればこれで十分です。

ただ、PowerShellでの方法には欠点があり、パスワードが付けられなかったり、サイズが2GBに制限されていたりなどの制約があります。そのようなパスワード保護や複雑な処理が必要な場合のみ7-Zipを検討しましょう。

7-zipなどの外部ライブラリはインストールが必要になるため、オフライン環境PCやインストール禁止PCなどでは利用できません。ただ、7-Zipに限って言えば、利用できるのであれば多数の機能がサポートされており、複雑なことをしたい場合は一番オススメです。

他のプログラミング言語ではそれらの言語がインストールされていることが必須になりますし、CopyHereメソッドはエラー処理に不備があるようで（公式リンク）、Microsoft自体が非推奨です。

というわけで、ここではPowerShellを使った方法を紹介します。

事前設定

以下に紹介するコードではWshShellクラスを利用しています。

WshShellの参照設定は、VBA画面→ツールメニュー→参照設定で「Windows Script Host Object Model」を選択します。これでWshShellクラスを利用できるようになります。

なお、参照設定を行わず、CreateObject関数を使う場合は「Dim obj」と「Set obj = CreateObject(“WScript.Shell”)」と書きます。

Dim obj
Set obj = CreateObject("WScript.Shell")

1 2	Dim obj Set obj = CreateObject("WScript.Shell")

ZIP圧縮関数：MakeZip

以下はフォルダやファイルをZIP形式で圧縮する関数です。

Function MakeZip(a_sPath As String, a_sZipPath As String) As Boolean
    Dim sh      As New IWshRuntimeLibrary.WshShell
    Dim ex      As WshExec
    Dim sCmd    As String
    
    '// 半角スペースをバッククォートでエスケープ
    a_sPath = Replace(a_sPath, " ", "` ")
    a_sZipPath = Replace(a_sZipPath, " ", "` ")
    
    '// Compress-Archive：圧縮コマンド
    '// -Path：フォルダパスまたはファイルパスを指定する。
    '// -DestinationPath：生成ファイルパスを指定する。
    '// -Force：生成ファイルが既に存在している場合は上書きする
    sCmd = "Compress-Archive -Path " & a_sPath & " -DestinationPath " & a_sZipPath & " -Force"
    
    '// コマンド実行
    Set ex = sh.Exec("powershell -NoLogo -ExecutionPolicy RemoteSigned -Command " & sCmd)
    
    '// コマンド失敗時
    If ex.Status = WshFailed Then
        '// 戻り値に異常を返す
        MakeZip = False
        
        '// 処理を抜ける
        Exit Function
    End If
    
    '// コマンド実行中は待ち
    Do While ex.Status = WshRunning
        DoEvents
    Loop
    
    '// 戻り値に正常を返す
    MakeZip = True
End Function

Function MakeZip(a_sPath As String, a_sZipPath As String) As Boolean

Dim sh As New IWshRuntimeLibrary.WshShell

Dim ex As WshExec

Dim sCmd As String

'// 半角スペースをバッククォートでエスケープ

a_sPath = Replace(a_sPath, " ", "` ")

a_sZipPath = Replace(a_sZipPath, " ", "` ")

'// Compress-Archive：圧縮コマンド

'// -Path：フォルダパスまたはファイルパスを指定する。

'// -DestinationPath：生成ファイルパスを指定する。

'// -Force：生成ファイルが既に存在している場合は上書きする

sCmd = "Compress-Archive -Path " & a_sPath & " -DestinationPath " & a_sZipPath & " -Force"

'// コマンド実行

Set ex = sh.Exec("powershell -NoLogo -ExecutionPolicy RemoteSigned -Command " & sCmd)

'// コマンド失敗時

If ex.Status = WshFailed Then

'// 戻り値に異常を返す

MakeZip = False

'// 処理を抜ける

Exit Function

End If

'// コマンド実行中は待ち

Do While ex.Status = WshRunning

DoEvents

Loop

'// 戻り値に正常を返す

MakeZip = True

End Function

コードの内容はコメントの通りですが、概要を説明します。

引数のパスに半角スペースがあった場合を考慮して、半角スペースをバッククォートでエスケープしています。

あとは、その引数を使ってPowerShellで実行するコマンド文字列をsCmd変数に入れてます。これがZIP圧縮するためのコマンドです。

そのあとにWshShell.Execメソッドで、PowerShellを呼び出してコマンドを渡しています。

NoLogo	PowerShell起動時の著作権のバナーを表示しません。
ExecutionPolicy	RemoteSignedでコマンドの実行を許可する。デフォルトはRestrictedが設定されており実行不可状態。
Command	実行するコマンドを指定する。

あとはコマンドの実行状態の判定を行い、失敗していたら異常を返し、処理中であれば終わるまで待って、終わったら正常を返します。

ZIP解凍関数：UnZip

ZIPファイルを解凍する関数です。

Function UnZip(a_sZipPath As String, a_sExpandPath As String) As Boolean
    Dim sh      As New IWshRuntimeLibrary.WshShell
    Dim ex      As WshExec
    Dim sCmd    As String
    
    '// 半角スペースをバッククォートでエスケープ
    a_sZipPath = Replace(a_sZipPath, " ", "` ")
    a_sExpandPath = Replace(a_sExpandPath, " ", "` ")
    
    '// Expand-Archive：解凍コマンド
    '// -Path：フォルダパスまたはファイルパスを指定する。
    '// -DestinationPath：生成ファイルパスを指定する。
    '// -Force：生成ファイルが既に存在している場合は上書きする
    sCmd = "Expand-Archive -Path " & a_sZipPath & " -DestinationPath " & a_sExpandPath & " -Force"
    
    '// コマンド実行
    Set ex = sh.Exec("powershell -NoLogo -ExecutionPolicy RemoteSigned -Command " & sCmd)
    
    '// コマンド失敗時
    If ex.Status = WshFailed Then
        '// 戻り値に異常を返す
        UnZip = False
        
        '// 処理を抜ける
        Exit Function
    End If
    
    '// コマンド実行中は待ち
    Do While ex.Status = WshRunning
        DoEvents
    Loop
    
    '// 戻り値に正常を返す
    UnZip = True
End Function

Function UnZip(a_sZipPath As String, a_sExpandPath As String) As Boolean

Dim sh As New IWshRuntimeLibrary.WshShell

Dim ex As WshExec

Dim sCmd As String

'// 半角スペースをバッククォートでエスケープ

a_sZipPath = Replace(a_sZipPath, " ", "` ")

a_sExpandPath = Replace(a_sExpandPath, " ", "` ")

'// Expand-Archive：解凍コマンド

'// -Path：フォルダパスまたはファイルパスを指定する。

'// -DestinationPath：生成ファイルパスを指定する。

'// -Force：生成ファイルが既に存在している場合は上書きする

sCmd = "Expand-Archive -Path " & a_sZipPath & " -DestinationPath " & a_sExpandPath & " -Force"

'// コマンド実行

Set ex = sh.Exec("powershell -NoLogo -ExecutionPolicy RemoteSigned -Command " & sCmd)

'// コマンド失敗時

If ex.Status = WshFailed Then

'// 戻り値に異常を返す

UnZip = False

'// 処理を抜ける

Exit Function

End If

'// コマンド実行中は待ち

Do While ex.Status = WshRunning

DoEvents

Loop

'// 戻り値に正常を返す

UnZip = True

End Function

コードの内容はZIP圧縮のMakeZip関数とほとんど同じです。コマンドがCompress-ArchiveからExpand-Archiveに変わっただけです。

ZIP圧縮関数（MakeZip）の使い方

ZIP圧縮を行うMakeZip関数の使い方のサンプルです。

第一引数に圧縮したいフォルダかファイルのパスを指定し、第二引数に作成する圧縮ファイルを拡張子の(.zip)も含めて指定して実行します。

Sub MakeZipTest()
    Dim sPath       As String
    Dim sZipPath    As String
    Dim bResult     As Boolean
    
    sPath = "C:\aaa\test"
    sZipPath = "C:\aaa\test.zip"
    
    bResult = MakeZip(sPath, sZipPath)
    
    If bResult = True Then
        Call MsgBox("圧縮しました。" & vbCr & sZipPath, vbOKOnly, "圧縮完了")
    Else
        Call MsgBox("圧縮失敗しました。" & vbCr & sZipPath, vbOKOnly, "圧縮失敗")
    End If
End Sub

Sub MakeZipTest()

Dim sPath As String

Dim sZipPath As String

Dim bResult As Boolean

sPath = "C:\aaa\test"

sZipPath = "C:\aaa\test.zip"

bResult = MakeZip(sPath, sZipPath)

If bResult = True Then

Call MsgBox("圧縮しました。" & vbCr & sZipPath, vbOKOnly, "圧縮完了")

Else

Call MsgBox("圧縮失敗しました。" & vbCr & sZipPath, vbOKOnly, "圧縮失敗")

End If

End Sub

ZIP解凍関数（UnZip）の使い方

ZIP解凍を行うUnZip関数の使い方のサンプルです。

Sub UnZipTest()
    Dim sZipPath    As String
    Dim sExpandPath As String
    Dim bResult     As Boolean
    
    sZipPath = "C:\aaaa\bbb\cc.zip"
    sExpandPath = "C:\aaaa\test"
    
    bResult = UnZip(sZipPath, sExpandPath)
    
    If bResult = True Then
        Call MsgBox("解凍しました。" & vbCr & sExpandPath, vbOKOnly, "解凍完了")
    Else
        Call MsgBox("解凍失敗しました。" & vbCr & sZipPath, vbOKOnly, "解凍失敗")
    End If
End Sub

Sub UnZipTest()

Dim sZipPath As String

Dim sExpandPath As String

Dim bResult As Boolean

sZipPath = "C:\aaaa\bbb\cc.zip"

sExpandPath = "C:\aaaa\test"

bResult = UnZip(sZipPath, sExpandPath)

If bResult = True Then

Call MsgBox("解凍しました。" & vbCr & sExpandPath, vbOKOnly, "解凍完了")

Else

Call MsgBox("解凍失敗しました。" & vbCr & sZipPath, vbOKOnly, "解凍失敗")

End If

End Sub

よくあるエラーと対処方法

パスが存在しないエラー

上に挙げたZIP圧縮関数（MakeZip）とZIP解凍関数（UnZip）は引数のパスが存在しているかどうかのチェックを行っていません。

チェックが必要な場合はフォルダ存在チェックやファイル存在チェックを行うようにしてください。

それぞれのチェックの詳細は「VBAでフォルダ存在チェック」「VBAでファイルの存在をチェックする」をご参照ください。

解凍後にフォルダが空になる

もし、zipを解凍したときに中身が空の場合は、圧縮時か解凍時のパスが間違ってますので確認してください。

確認ポイント：

パスの区切り文字がバックスラッシュ（\）になっているか
フォルダ名やファイル名に誤字がないか
圧縮対象のフォルダ・ファイルが実際に存在するか

ExecutionPolicy エラー

「スクリプトの実行が無効になっています」というエラーが出る場合、PowerShellの実行ポリシーが制限されています。

コード内で-ExecutionPolicy RemoteSignedを指定しているため通常は問題ありませんが、環境によってはシステム管理者による設定変更が必要です。

まとめ

VBAでZIP圧縮・解凍を行うには、PowerShellを活用する方法が最も汎用的で確実です。

この方法のメリット：

追加ソフトのインストール不要
Windows標準機能のみで動作
ほとんどの業務PCで利用可能

制限事項：

パスワード保護は不可
2GBの容量制限あり

複雑な処理が必要な場合は7-Zipの利用を検討してください。「VBAで7-Zipでの圧縮と解凍を行う方法」