zipファイルを展開(解凍)する。（CopyHereメソッド）

VBAを利用してzip形式のファイルを展開（解凍）するにはCopyHereメソッド利用することで展開することができます。

なお、このCopyHereメソッドを利用したzipファイルの作成は現在Microsoftの公式サポートで非推奨の方法となっています。
　「CopyHere メソッドから Zip ファイルを処理することはできません」

下記のサンプルコードでは展開を実行する前に対象のファイルがzip形式であるかをファイルの拡張子とバイナリを読み込み確認をしています。

　●zipファイルを展開（解凍）

'*****************************************************************
'　zipファイルの展開（解凍）
'*****************************************************************
Sub main_Unzip()
    
    Dim sZipFile As String
    sZipFile = "C:\VBA\archive\ZipTest_Copyhere.zip"
    
    Dim sUnzipFolder  As String
    sUnzipFolder = "C:\VBA\archive_unzip\"
    
    If UnZipFile(sZipFile, sUnzipFolder) Then
        MsgBox "完了"
    Else
        MsgBox "展開できませんでした。"
    End If

End Sub

'*****************************************************************
'　展開処理
'-----------------------------------------------------------------
'　　第１引数：zipファイルのパス
'　　第２引数：展開先のパス（指定なしの場合はzipと同じ場所に展開）
'-----------------------------------------------------------------
'　　戻り値　：確認結果（True:正常終了、False:異常終了）
'*****************************************************************
Public Function UnZipFile(ByVal getZipPath As String, Optional getDstPath As String = "")
    
    'FileSystemObjectの作成
    Dim oFSO As Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    
    'zipファイルか判定（拡張子とバイナリで判断）
    If LCase(oFSO.GetExtensionName(getZipPath)) = "zip" _
       And chkBinaryZipOrNot(getZipPath) Then
    
        Dim vZipPath  As Variant
        vZipPath = getZipPath
    
        '展開先の確認
        'フォルダではない、第2引数が指定されていない場合はzipと同じ場所に展開
        Dim vDstPath As Variant
        If Not (oFSO.FolderExists(getDstPath)) Then
            'zipファイルのあるフォルダを取得
            vDstPath = oFSO.GetFile(getZipPath).ParentFolder.Path
        Else
            '指定の展開先を設定
            vDstPath = getDstPath
        End If
        
        'Shell.Applicationオブジェクトの作成
        Dim oShell As Object
        Set oShell = CreateObject("Shell.Application")
        oShell.Namespace(vDstPath).CopyHere oShell.Namespace(vZipPath).Items
    
        UnZipFile = True
    Else
        UnZipFile = False
    End If

End Function

'*****************************************************************
'　zipファイルか確認（バイナリで判断）
'-----------------------------------------------------------------
'　　第１引数：対象ファイルのパス
'-----------------------------------------------------------------
'　　戻り値　：確認結果（True:zip、False:zip以外）
'*****************************************************************
Function chkBinaryZipOrNot(getPath As String) As Boolean
        
    chkBinaryZipOrNot = False
        
    '取得バイト数の指定（4バイトでZIPか判断）
    Dim lGetSize As Long
    lGetSize = 4
    
    'ファイル番号取得
    Dim lFn As Long
    lFn = FreeFile
    
    'ファイルをバイナリで開く
    Open getPath For Binary Access Read As #lFn
    
    'ファイルサイズ取得
    Dim lFileSize  As Long
    lFileSize = LOF(lFn)
    
    '指定のサイズよりファイルサイズが小さい場合は終了
    If lGetSize > lFileSize Then
        Close #lFn
        chkBinaryZipOrNot = False
        Exit Function
    End If
   
    'バイナリデータを1バイトずつ取得
    Dim i As Long
    Dim sByteData As Byte
    Dim sBinary As String
    For i = 1 To lGetSize
        Get #lFn, i, sByteData
        sBinary = sBinary & Chr(sByteData)
    Next
    
    'ファイルを閉じる
    Close #lFn
    
    If sBinary = ("PK") Then
        chkBinaryZipOrNot = True
    End If

    
End Function

　■実行結果