呼び出し元プロシージャ
'解凍呼び出しテスト 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