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

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

今回ご紹介するプロシージャは

プロシージャ名	概要
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:新規)
'------------------------------------------------------------------------------------------------------------------------------
    
    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")
    
    '親フォルダ取得
    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:新規)
'------------------------------------------------------------------------------------------------------------------------------

    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")

    '親フォルダ取得
    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シリーズ記事一覧

もしよろしければ他の記事もご覧ください！