Excel VBA 逆引き集 | 圧縮・展開

Excel VBA
スポンサーリンク

ねらい：VBAから「圧縮・展開」を安定運用し、配布やバックアップを一気に楽にする

圧縮・展開は、成果物の配布、ログの保管、バックアップの軽量化などに直結します。Excel VBAでは「Windows標準のZIP（Shell.NameSpace）」を使う方法が最短で参照設定も不要。さらに、7-ZipやPowerShellを併用すれば大容量やパスワード付きなどの現場要件にも対応できます。初心者でも貼って動かせるテンプレと、壊れにくい“待機・クオート・後片付け”の要点をかみ砕いて解説します。

Windows標準ZIP：Shell.Applicationで圧縮・展開する

空ZIPの作成とフォルダ圧縮（貼って動く）

' ModZipNative.bas
Option Explicit

Public Sub ZipFolder(ByVal srcFolder As String, ByVal zipPath As String)
    On Error GoTo EH
    If Dir(zipPath, vbNormal) <> "" Then Kill zipPath
    CreateEmptyZip zipPath

    Dim sh As Object: Set sh = CreateObject("Shell.Application")
    Dim srcNS As Object: Set srcNS = sh.NameSpace(srcFolder)
    Dim dstNS As Object: Set dstNS = sh.NameSpace(zipPath)
    If srcNS Is Nothing Or dstNS Is Nothing Then Err.Raise 8001, , "パス不正"

    ' 16 = 進捗/ダイアログ抑制。必要に応じて調整。
    dstNS.CopyHere srcNS.Items, 16

    ' 簡易待機：件数やサイズ次第で延長（後述の堅牢待機へ差し替え可）
    WaitSmall 2
    MsgBox "圧縮完了: " & zipPath, vbInformation
    Exit Sub
EH:
    MsgBox "失敗: " & Err.Description, vbExclamation
End Sub

Private Sub CreateEmptyZip(ByVal zipPath As String)
    Dim h As Integer: h = FreeFile
    Open zipPath For Binary As #h
    ' ZIP終端レコード（“PK”＋終端）。空のZIPを作る定番ヘッダー。
    Put #h, , Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String$(18, Chr$(0))
    Close #h
End Sub

Private Sub WaitSmall(ByVal seconds As Double)
    Dim t As Double: t = Timer
    Do While Timer - t < seconds
        DoEvents
    Loop
End Sub
VB

ZIPの展開（貼って動く）

Public Sub UnzipToFolder(ByVal zipPath As String, ByVal dstFolder As String)
    On Error GoTo EH
    If Dir(dstFolder, vbDirectory) = "" Then MkDir dstFolder

    Dim sh As Object: Set sh = CreateObject("Shell.Application")
    Dim zipNS As Object: Set zipNS = sh.NameSpace(zipPath)
    Dim dstNS As Object: Set dstNS = sh.NameSpace(dstFolder)
    If zipNS Is Nothing Or dstNS Is Nothing Then Err.Raise 8002, , "パス不正"

    dstNS.CopyHere zipNS.Items, 16
    WaitSmall 2
    MsgBox "展開完了: " & dstFolder, vbInformation
    Exit Sub
EH:
    MsgBox "失敗: " & Err.Description, vbExclamation
End Sub
VB

重要ポイントの深掘り

  • Shell.NameSpaceのZIPは“簡単・互換が高い”反面、完了検知が弱いです。件数やサイズに応じて待機を調整し、必要なら「堅牢待機」に差し替えます。
  • 見た目のダイアログを抑えるにはCopyHereのフラグ（16）を使います。ポリシーや管理者設定でダイアログが出る環境では、外部ツールの利用を検討します。
  • Windows標準ZIPは“パスワード付与不可”。暗号化ZIPなどが要件なら後述の7-Zip等を使うのが確実です。

大容量・厳密完了向け：件数監視で「堅牢待機」にする

展開の進捗をファイル数で監視（より堅牢）

' ModZipRobust.bas
Option Explicit

Public Sub UnzipRobust(ByVal zipPath As String, ByVal dstFolder As String)
    On Error GoTo EH
    If Dir(dstFolder, vbDirectory) = "" Then MkDir dstFolder
    Dim sh As Object: Set sh = CreateObject("Shell.Application")
    Dim zipNS As Object: Set zipNS = sh.NameSpace(zipPath)
    Dim dstNS As Object: Set dstNS = sh.NameSpace(dstFolder)
    If zipNS Is Nothing Or dstNS Is Nothing Then Err.Raise 8003, , "パス不正"

    Dim expectCount As Long: expectCount = zipNS.Items.Count
    dstNS.CopyHere zipNS.Items, 16

    Dim start As Double: start = Timer
    Do
        DoEvents
        If CountFiles(dstFolder) >= expectCount Then Exit Do
        If Timer - start > 60 Then Err.Raise 8004, , "タイムアウト（60秒）"
    Loop

    MsgBox "展開完了（" & expectCount & "件）: " & dstFolder, vbInformation
    Exit Sub
EH:
    MsgBox "失敗: " & Err.Description, vbExclamation
End Sub

Private Function CountFiles(ByVal folderPath As String) As Long
    Dim d As Long
    Dim f As String: f = Dir(folderPath & "\*.*", vbNormal)
    Do While Len(f) > 0
        d = d + 1
        f = Dir
    Loop
    CountFiles = d
End Function
VB

重要ポイントの深掘り

  • ZIPの中身件数（NameSpaceのItems.Count）を取得し、出力側ファイル件数が到達したら完了判定にすることで“曖昧な待機”を卒業できます。
  • 大量小さなファイルで遅くなりやすいので、タイムアウトとリトライ（再試行）ポリシーを設けると現場で止まりません。

7-Zipなど外部ツールを併用：速度・機能（暗号化）を一挙に満たす

7z.exeを呼んでZIP作成・展開（戻り値で判定）

' ModZip7z.bas
Option Explicit

Public Sub ZipWith7z(ByVal srcFolder As String, ByVal zipPath As String, Optional ByVal password As String = "")
    On Error GoTo EH
    Dim exe As String: exe = """C:\Program Files\7-Zip\7z.exe"""
    Dim cmd As String
    If Len(password) > 0 Then
        cmd = exe & " a -tzip -p" & """" & password & """" & " -y " & _
              """" & zipPath & """ " & """" & srcFolder & "\*"""
    Else
        cmd = exe & " a -tzip -y " & """" & zipPath & """ " & """" & srcFolder & "\*"""
    End If
    ShellRunWait cmd
    MsgBox "7-Zip圧縮完了: " & zipPath, vbInformation
    Exit Sub
EH:
    MsgBox "失敗: " & Err.Description, vbExclamation
End Sub

Public Sub UnzipWith7z(ByVal zipPath As String, ByVal dstFolder As String, Optional ByVal password As String = "")
    On Error GoTo EH
    Dim exe As String: exe = """C:\Program Files\7-Zip\7z.exe"""
    Dim cmd As String
    If Len(password) > 0 Then
        cmd = exe & " x -p" & """" & password & """" & " -y " & """" & zipPath & """ -o" & """" & dstFolder & """"
    Else
        cmd = exe & " x -y " & """" & zipPath & """ -o" & """" & dstFolder & """"
    End If
    ShellRunWait cmd
    MsgBox "7-Zip展開完了: " & dstFolder, vbInformation
    Exit Sub
EH:
    MsgBox "失敗: " & Err.Description, vbExclamation
End Sub

Private Sub ShellRunWait(ByVal cmd As String)
    Dim sh As Object: Set sh = CreateObject("WScript.Shell")
    Dim rc As Long: rc = sh.Run(cmd, 0, True) ' 非表示・待機
    If rc <> 0 Then Err.Raise 8010, , "外部コマンド失敗: " & rc
End Sub
VB

重要ポイントの深掘り

  • 7-Zipは“暗号化ZIP・巨大データ・細かい制御”に強い。戻り値（rc）で成功／失敗を確実に判定できます。
  • パスやパスワードは必ずダブルクォートで囲み、スペースや日本語を含む環境でも安全に動かします。
  • 企業PCではインストールパスが異なる場合があるため、設定ファイル化すると配布が楽です。

PowerShell併用：Compress-Archive／Expand-Archiveで標準機能を活用

PowerShellを呼び出してZIP作成・展開

' ModZipPs.bas
Option Explicit

Public Sub ZipWithPowerShell(ByVal srcFolder As String, ByVal zipPath As String)
    Dim sh As Object: Set sh = CreateObject("WScript.Shell")
    Dim cmd As String
    cmd = "powershell -NoProfile -ExecutionPolicy Bypass -Command " & _
          """Compress-Archive -Path '" & Replace(srcFolder, "'", "''") & "\*' -DestinationPath '" & Replace(zipPath, "'", "''") & "' -Force"""
    Dim rc As Long: rc = sh.Run(cmd, 0, True)
    If rc <> 0 Then Err.Raise 8020, , "PowerShell圧縮失敗: " & rc
End Sub

Public Sub UnzipWithPowerShell(ByVal zipPath As String, ByVal dstFolder As String)
    Dim sh As Object: Set sh = CreateObject("WScript.Shell")
    Dim cmd As String
    cmd = "powershell -NoProfile -ExecutionPolicy Bypass -Command " & _
          """Expand-Archive -Path '" & Replace(zipPath, "'", "''") & "' -DestinationPath '" & Replace(dstFolder, "'", "''") & "' -Force"""
    Dim rc As Long: rc = sh.Run(cmd, 0, True)
    If rc <> 0 Then Err.Raise 8021, , "PowerShell展開失敗: " & rc
End Sub
VB

重要ポイントの深掘り

  • PowerShell標準のCompress/Expandは“暗号化なし・標準ZIP限定”ですが、ログや戻り値の扱いが明確で運用に向いています。
  • 実行ポリシーや社内ポリシーに従いつつ、-NoProfile/-ExecutionPolicy Bypassを付与するとトラブルが減ります。

例題の通し方：成果物フォルダをZIPにして配布・後で展開

フロー例

  • ReportフォルダをZipFolderでZIP化し、メール添付やファイルサーバへ置く。
  • 受け側でUnzipRobustを使って展開し、件数を確認して正しく復元されたことを担保。
  • パスワード要件がある案件はZipWith7z/UnzipWith7zに切り替え、戻り値判定でエラー時の再試行ルールを適用。

検証ポイント

  • ZIP作成・展開の完了が“確実に”検知できているか（堅牢待機／戻り値）。
  • パスに日本語やスペースが含まれても失敗しないか（ダブルクォート徹底）。
  • 出力先がネットワークドライブの場合、まずローカルに作ってから移動すると安定する。

落とし穴と対策（深掘り）

Shell.NameSpaceの曖昧な完了

大容量・多数ファイルで終わりが読みにくい。件数監視か、7-Zip／PowerShellへ切り替えを。

パスワード付きZIPの要件

Windows標準では不可。7-Zipを使う（-pオプション）。社内で鍵管理とポリシー周知が必須。

ファイルロック・権限問題

使用中ファイルの圧縮は失敗します。対象フォルダの「占有解除」を運用ルールに。管理者権限が必要なパスは事前に確認。

文字コード・ファイル名の互換

異なるOSやツールとのやり取りで文字化けが起きることがあります。UTF-8前提のツール活用と、テスト配布で事前検証を。

共通枠と運用の型

開始・終了枠（環境復帰を保証）

' ModApp.bas
Option Explicit
Public Sub AppEnter(Optional ByVal status As String = "")
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    If Len(status) > 0 Then Application.StatusBar = status
End Sub
Public Sub AppLeave()
    Application.StatusBar = False
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
VB
  • 圧縮・展開はファイルI/Oで時間がかかることがあります。開始・終了枠でUIの揺らぎを抑え、失敗時も必ず復帰させます。

まとめ：標準ZIPで「最短実装」、要件に応じて7-ZipやPowerShellへ拡張

  • まずはShell.NameSpaceで“簡単に”圧縮・展開。件数監視で堅牢化。
  • パスワード・大容量・厳密完了は7-ZipかPowerShellを併用。戻り値で確実に判定。
  • クオート・待機・タイムアウト・開始/終了枠の徹底で、初心者でも壊れない運用が作れます。

スポンサーリンク
タイトルとURLをコピーしました