ray88’s diary

お仕事で困ったとき用の自分用の覚書

VBA zipファイルを解凍する

呼び出し元プロシージャ

'解凍呼び出しテスト
Function testmelting()
    '変数の宣言
    Dim filepath As Variant
    Dim meltpath As Variant
    Dim ret As Boolean
    
    'ファイルのパスを格納
    filepath = "ここにZIPファイルのパスを入れる"
    meltpath = "ここに解凍先フォルダを入れる"
    
    'ZIP解凍を実行
    ret = unzipman(filepath, meltpath)
End Function

ファンクションプロシージャ

Option Explicit
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)

'OS標準機能でzipファイルを解凍する関数
Public Function unzipman(ByVal filepath As Variant, ByVal meltpath As Variant) As Boolean
    On Error GoTo Err_Handler
    '指定のフォルダが存在するかチェック
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    If FSO.FolderExists(meltpath) Then
    Else
        MkDir meltpath
    End If
    Set FSO = Nothing
    
    'シェルを呼び出し
    With CreateObject("Shell.Application")
      .Namespace(meltpath).CopyHere .Namespace(filepath).Items
    End With
    
    '結果を返す
    unzipman = True
    Exit Function
 
Exit_unzipman:
    unzipman = False
    Exit Function
    
Err_Handler:
    MsgBox Err.Description
    Resume Exit_unzipman
    
End Function

ray88.hatenablog.com