第8回 直感！スグに使える業務向けVBA汎用プロシージャ(zip・tar解凍)

第0回で配布しました汎用プロシージャのコードの紹介と簡単な解説をやっていきたいと思います！
以下のリンクから .bas ファイルをダウンロードできます（zipファイル）

https://drive.google.com/file/d/11qEUTsq87UItzoKu2okX5WgEopRercCb/view?usp=drive_link

今回ご紹介するプロシージャは
| プロシージャ名		| 概要						|
|-------------------------------|-----------------------------------------------|
| UnzipFile | zip解凍(PowerShell経由)	|
| UnpackTar | tar解凍(PowerShell経由)	|

圧縮ファイルである.zipファイルと.tar、.tar.gzファイルを解凍するプロシージャたちです。VBAでそんなことできるんだと思ったシリーズの一つですね(笑)

第5回のフォルダ・ファイル操作ではコマンドプロンプト(cmd)を経由しておりましたが、今回はPowerShellを経由して行います。ZIPファイルを解凍するツールは作った経験があるのですが、ChatGPTさんに聞いたところTARファイルの解凍もPowerShellでできると教えていただいたので併せてご紹介します！

## UnzipFile
~~~
Sub UnzipFile(zipPath As String, Optional extractType As Long = 2)
'------------------------------------------------------------------------------------------------------------------------------
'　概要　　｜zipファイルをPowerShellで解凍(その場 or 同名フォルダに展開可能)
'------------------------------------------------------------------------------------------------------------------------------
'　引数１　｜zipPath - 解凍対象のZipファイルパス(String型)
'　引数２　｜extractType - 解凍パターン(1=その場, 2=同名フォルダを作成、既定値=2)(Long型)
'------------------------------------------------------------------------------------------------------------------------------
'　実装　　｜Ver.1.0.0(2025/04/20:新規)
'　　　　　｜Ver.1.1.0(2025/06/14:ユーザー定義エラーを追加)
'------------------------------------------------------------------------------------------------------------------------------
    
    Dim dummyCount      As Long '重複回避用変数
    Dim extractTo       As String '解凍先フォルダ
    Dim zipName         As String '解凍後フォルダ名
    Dim shellCommand    As String 'PowerShell入力コマンド
    Dim fsObject        As Object
    Dim wShell          As Object
    
    Set fsObject = CreateObject("Scripting.FileSystemObject")
    Set wShell = CreateObject("WScript.Shell")
    
    'ユーザー定義エラー
    If extractType <> 1 And extractType <> 2 Then
        Err.Raise vbObjectError + 1001, "UnzipFile", "引数は1(その場に展開)または2(同名フォルダ作成)にしてください"
    End If
    
    '親フォルダ取得
    extractTo = fsObject.GetParentFolderName(zipPath)
    
    '同名フォルダ作成
    If extractType = 2 Then
        zipName = fsObject.GetBaseName(zipPath)
        extractTo = extractTo & "\" & zipName
        
        Dim dummyCount As Long
        dummyCount = 1
        
        Do While Dir(extractTo, vbDirectory) <> ""
            extractTo = fsObject.GetParentFolderName(zipPath) & "\" & zipName & "_" & dummyCount
            dummyCount = dummyCount + 1
        Loop
        MkDir extractTo
    End If
    
    'スペース対応
    zipPath = """" & zipPath & """"
    extractTo = """" & extractTo & """"
    
    'PowerShellコマンド構築
    shellCommand = "powershell -Command ""Expand-Archive -LiteralPath " & zipPath & " -DestinationPath " & extractTo & " -Force"""
    
    '実行
    wShell.Run shellCommand, 0, True
    
End Sub
~~~

## UnpackTar
~~~
Sub UnpackTar(tarPath As String, Optional extractType As Long = 2)
'------------------------------------------------------------------------------------------------------------------------------
'　概要　　｜tarファイル(.tar / .tar.gz)をPowerShellで展開(その場 or 同名フォルダ)
'------------------------------------------------------------------------------------------------------------------------------
'　引数１　｜tarPath - 解凍対象のtarファイルパス(String型)
'　引数２　｜extractType - 解凍パターン(1=その場, 2=同名フォルダを作成、既定値=2)(Long型)
'------------------------------------------------------------------------------------------------------------------------------
'　実装　　｜Ver.1.0.0(2025/04/20:新規)
'　　　　　｜Ver.1.1.0(2025/0x/xx:ユーザー定義エラーを追加
'------------------------------------------------------------------------------------------------------------------------------
    
    Dim dummyCount      As Long '重複回避用変数
    Dim extractTo       As String '解凍先フォルダ
    Dim tarName         As String '解凍後フォルダ名
    Dim shellCommand    As String 'PowerShell入力コマンド
    Dim fsObject        As Object
    Dim wShell          As Object
    
    Set fsObject = CreateObject("Scripting.FileSystemObject")
    Set wShell = CreateObject("WScript.Shell")
    
    'ユーザー定義エラー
    If extractType <> 1 And extractType <> 2 Then
        Err.Raise vbObjectError + 1001, "UnzipFile", "引数は1(その場に展開)または2(同名フォルダ作成)にしてください"
    End If
    
    '親フォルダ取得
    extractTo = fsObject.GetParentFolderName(tarPath)
    
    '同名フォルダを作成
    If extractType = 2 Then
        tarName = fsObject.GetBaseName(tarPath)
        extractTo = extractTo & "\" & tarName
        dummyCount = 1
        Do While Dir(extractTo, vbDirectory) <> ""
            extractTo = fsObject.GetParentFolderName(tarPath) & "\" & tarName & "_" & dummyCount
            dummyCount = dummyCount + 1
        Loop
        MkDir extractTo
    End If
    
    'スペース対応
    tarPath = """" & tarPath & """"
    extractTo = """" & extractTo & """"
    
    'PowerShell コマンドの構築
    shellCommand = "powershell -Command ""tar -xf " & tarPath & " -C " & extractTo & """"
    
    '実行
    wShell.Run shellCommand, 0, True
    
End Sub

~~~

## 動作解説
本プロシージャたちでは第2引数にて親フォルダ内に解凍するパターンと圧縮ファイル名と同名のフォルダ(重複回避有り)を生成しその中に解凍するパターンを選ぶことができます。プロシージャ単体の動作だけでは圧縮ファイル本体は削除されず残ります。

圧縮ファイルを解凍後削除したい場合は
~~~
Kill "圧縮ファイルフルパス"
~~~
で削除することができます。Optionalで第3引数に解凍後削除する選択肢を入れようかも悩みましたが、個人的に直感性を高めるためにOptionalの引数は1プロシージャにつき原則1つとしたかったため外させていただきました。このようなプログラムの設計思想って悩ましくもあり楽しくもありますね！

## 直感！VBAシリーズ記事一覧
もしよろしければ他の記事もご覧ください！

https://qiita.com/Reko/items/3e482f9a73353e964f00

https://qiita.com/Reko/items/af042ae33cdc01e1dc96

https://qiita.com/Reko/items/9e211c9c496e12283f33

https://qiita.com/Reko/items/c2dab7b0e8207f8049df

https://qiita.com/Reko/items/b5abcdf614cef5d4073a

https://qiita.com/Reko/items/3451339e723a34ac7897

https://qiita.com/Reko/items/40c66556ac51a8006ea6

https://qiita.com/Reko/items/0269b2bece07a675e797

https://qiita.com/Reko/items/b995c3da88d25f6e0104

https://qiita.com/Reko/items/bc97d79599cfd431b2f3

https://qiita.com/Reko/items/1731aaddfc6e50c209df

https://qiita.com/Reko/items/554a47f2aa944e2eec5e

https://qiita.com/Reko/items/e8253ac68ccafba44ad3