指定フォルダ配下の圧縮ファイルをすべて解凍します。
今のところ、ALZIPとLhaplusに対応しています。
ExcelのC3セルを、ご自分の環境の解凍ツールのパスに書き換えて使ってください。
よく知らないけど「ALZIP」は韓国製ソフトっぽいです。
このお題をくれた人の環境が「ALZIP」なので使っていますが、ご利用は自己責任でお願いいたします。
こういうツールは頑張りすぎない主義なので、入力チェックなどは最低限です。
あまりスタイリッシュなコードにはなっていなくて気に入らないので、どうでも良くならなかったらリファクタリングします。
コマンドで使える、他の解凍ツールへの対応にリクエストがあれば、追加修正するかもしれません。
ソースコード
Option Explicit
'---------------------------------------------------------------------------------------------------
' 変数
'---------------------------------------------------------------------------------------------------
' ツール > 参照設定 > Windows Script Host Object Model
Private wsh As IWshRuntimeLibrary.WshShell
Private oDir As Folder ' フォルダオブジェクト
Private oFile As File ' ファイルオブジェクト
Private ToolPath As String ' 解凍ツールパス
Private UnzipSrc As String ' 解凍元先頭パス
Private UnzipDst As String ' 解凍先パス
Private UnzipCommandTemplate As String ' 解凍コマンドテンプレート
Private commandList As Dictionary ' 解凍ツールのコマンドのリスト
'---------------------------------------------------------------------------------------------------
'【処 理 名】初期処理
'---------------------------------------------------------------------------------------------------
Private Sub init()
Set wsh = New IWshRuntimeLibrary.WshShell
'解凍ツールパス
ToolPath = ThisWorkbook.Worksheets("解凍ちゃん").Range("C3").Value
'解凍元先頭パス
UnzipSrc = ThisWorkbook.Worksheets("解凍ちゃん").Range("C4").Value
'解答先パス
UnzipDst = ThisWorkbook.Worksheets("解凍ちゃん").Range("C5").Value
End Sub
'---------------------------------------------------------------------------------------------------
'【処 理 名】終期処理
'---------------------------------------------------------------------------------------------------
Private Sub term()
Set oDir = Nothing
Set oFile = Nothing
Set wsh = Nothing
Set commandList = Nothing
End Sub
'---------------------------------------------------------------------------------------------------
'【処 理 名】解凍
'【処理概要】指定ディレクトリ配下のすべてのgzファイルを解凍する
'【引 数】なし
'【返 却 値】なし
'---------------------------------------------------------------------------------------------------
Public Sub 解凍()
'初期化
Call init
'入力チェック
If Not validation() Then
Exit Sub
End If
'ツールパスの補正
Call createToolList
Call editUnzipCommand
'メイン処理
Call サブフォルダまでくるくるして解凍(UnzipSrc)
'終期化
Call term
MsgBox "おしまい"
End Sub
'---------------------------------------------------------------------------------------------------
'【処 理 名】サブフォルダまでくるくるして解凍
'【処理概要】指定ディレクトリ配下のすべてのgzファイルを解凍する
'【引 数】[I] ByVal sTopPath As String フォルダパス
'【返 却 値】なし
'---------------------------------------------------------------------------------------------------
Private Sub サブフォルダまでくるくるして解凍(ByVal sTopPath As String)
' ツール > 参照設定 > Microsoft Scripting Runtime
Dim oFso As New FileSystemObject ' ファイルシステムオブジェクト
Dim UnzipCommand As String '解凍コマンド
'指定フォルダ配下のサブフォルダすべてに対して処理する
For Each oDir In oFso.GetFolder(sTopPath).SubFolders
Call サブフォルダまでくるくるして解凍(oDir.Path)
Next
'フォルダ直下のすべてのファイル
For Each oFile In oFso.GetFolder(sTopPath).Files
UnzipCommand = Replace(UnzipCommandTemplate, "{src}", oFile.Path)
' コマンドを実行
wsh.Run UnzipCommand
DoEvents
Next
End Sub
'---------------------------------------------------------------------------------------------------
'【処 理 名】入力チェック
'【処理概要】入力チェックを行う
'【引 数】なし
'【返 却 値】True エラーなし
' False エラーあり
'---------------------------------------------------------------------------------------------------
Private Function validation() As Boolean
If ToolPath = "" Then
MsgBox ("解凍ツールパスを入力してください。")
GoTo LBL_ERROR
End If
If Dir(ToolPath) = "" Then
MsgBox "解凍ツールが存在しません。"
GoTo LBL_ERROR
End If
If UnzipSrc = "" Then
MsgBox ("解凍元パスを入力してください。")
GoTo LBL_ERROR
End If
If Dir(UnzipSrc, vbDirectory) = "" Then
MsgBox "解凍元ファイルが存在しません。"
GoTo LBL_ERROR
End If
validation = True
Exit Function
LBL_ERROR:
validation = False
Exit Function
End Function
'---------------------------------------------------------------------------------------------------
'【処 理 名】解凍ツール実行コマンド生成
'【処理概要】解凍ツールの実行コマンドを生成する
'【引 数】なし
'【返 却 値】なし
'---------------------------------------------------------------------------------------------------
Private Sub editUnzipCommand()
' ツール > 参照設定 > Microsoft Scripting Runtime
Dim oFso As New FileSystemObject ' ファイルシステムオブジェクト
Dim key As String
key = oFso.GetBaseName(ToolPath)
UnzipCommandTemplate = Replace(commandList(key), "{tool}", ToolPath)
UnzipCommandTemplate = Replace(UnzipCommandTemplate, "{dst}", UnzipDst)
End Sub
'---------------------------------------------------------------------------------------------------
'【処 理 名】解凍コマンドリスト生成
'【処理概要】解凍コマンドのリストを生成する
'【引 数】なし
'【返 却 値】なし
'---------------------------------------------------------------------------------------------------
Private Sub createToolList()
Dim key As Variant
Set commandList = New Dictionary
'ALZIP
commandList.Add "ALZipCon", """{tool}"" -x ""{src}"" ""{dst}"""
'LHAPLUS
commandList.Add "Lhaplus", """{tool}"" ""{src}"" ""/o:{dst}"""
End Sub
