Zipファイルを解凍(パスワードなし)

Zipファイルを解凍します。
標準機能にzipファイル関連の機能はありません。
PowerShellの圧縮、解凍コマンドを利用します。

Option Explicit

Sub UnZip_Click()
	Dim result As Boolean

	result = UnZip("C:\ExcelVBA\zipファイル\test.zip", "C:\ExcelVBA\zipファイル\ok")
	If result = True Then
		MsgBox "解凍完了"
	Else
		MsgBox "解凍失敗"
	End If
End Sub


' Zipファイルを解凍
Function UnZip(filename As String, outdir As String) As Boolean

	Dim wsh As New IWshRuntimeLibrary.WshShell
	Dim WshResult As WshExec
	Dim cmd As String
	Dim fso As Object
	Dim psStr As String

	Set fso = CreateObject("Scripting.FileSystemObject")

	If fso.FileExists(filename) = False Then    ' ファイルの有無を確認
		' Zipファイルが無い場合
		UnZip = False
		Exit Function
	End If

	' Expand-Archive:解凍コマンド
	'    -Force:既に存在している場合は上書き
	'   ファイル名をフォルダにする
	cmd = "Expand-Archive -Path """ & filename & """ -DestinationPath """ & outdir & _
		"\" & fso.GetBaseName(filename) & """ -Force"
    
	' コマンド実行
	psStr = "powershell -NoLogo -ExecutionPolicy RemoteSigned -Command "
	Set WshResult = wsh.Exec(psStr & cmd)

	If WshResult.Status = WshFailed Then
		' コマンド失敗
		UnZip = False
	Else
		' コマンド実行中は待つ
		Do While WshResult.Status = WshRunning
			DoEvents
		Loop

		' コマンド正常
		UnZip = True
	End If
End Function

コメント