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


コメント