VBAでZIP圧縮と解凍を行う方法
VBAの標準機能にはZIPファイル関連の機能がありません。
無いのであればなんらかの別の方法で行うことになります。具体的には以下が挙げられます。
- PowerShellの圧縮、解凍コマンドを利用する。
- 7-Zipなどの外部ライブラリを利用する。（7-Zipを利用する方法は「VBAで7-Zipでの圧縮と解凍を行う方法」をご参照ください）
- 他のプログラミング言語のZIP関連機能を利用する。
- WshShell.NameSpace.CopyHereメソッドでのZipファイルへのコピー処理を利用する。ただし、Microsoft非推奨（公式リンク）。
どれも一長一短がありますが、より多くのPCで一番確実に動作するのはPowerShellでの方法です。
ただ、PowerShellでの方法には欠点があり、パスワードが付けられなかったり、サイズが2GBに制限されていたりなどの制約があります。ただ、パスワードなしの単純な圧縮と解凍であればこれで十分です。
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”)」と書きます。
圧縮関数
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 |
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 | 実行するコマンドを指定する。 |
あとはコマンドの実行状態の判定を行い、失敗していたら異常を返し、処理中であれば終わるまで待って、終わったら正常を返します。
解凍関数
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 |
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 |
コードの内容はMakeZip関数とほとんど同じです。コマンドがCompress-ArchiveからExpand-Archiveに変わっただけです。
使い方
圧縮関数の使い方のサンプルです。
第一引数に圧縮したいフォルダかファイルのパスを指定し、第二引数に作成する圧縮ファイルを拡張子の(.zip)も含めて指定して実行します。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
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 |
解凍関数の使い方のサンプルです。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
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 |
注意点
圧縮関数と解凍関数は引数のパスが存在しているかどうかのチェックを行っていません。
チェックが必要な場合はフォルダ存在チェックやファイル存在チェックを行うようにしてください。
それぞれのチェックの詳細は「VBAでフォルダ存在チェック」「VBAでファイルの存在をチェックする」をご参照ください。
もし、zipを解凍したときに中身が空の場合は、圧縮時か解凍時のパスが間違ってますので確認してください。