Option Explicit

Private Sub UnzipFile(ByVal zipFile As String, ByVal targetDir As String)

    ' 引用 Microsoft Scripting Runtime 库

    Dim fso As New FileSystemObject

    ' 声明局部变量 zip

    Dim zip As New zipFile

    ' 打开 zip 文件

    zip.Open zipFile, zipFile.OpenRead

    ' 解压缩文件到目标目录

    Dim file As ZipEntry

    For Each file In zip.Items

        Dim filePath As String

        filePath = targetDir & "\" & file.Name

        ' 如果目标路径不存在，则创建路径

        If Not fso.FolderExists(Left(filePath, InStr(filePath, "\") - 1)) Then

            fso.CreateFolder Left(filePath, InStr(filePath, "\") - 1)

        End If

        ' 解压缩文件

        file.Extract filePath, True

    Next file

    ' 关闭 zip 文件

    zip.Close

End Sub

Private Sub Command1_Click()

    Dim zipFile As String, targetDir As String, result As String

    zipFile = "D:\example.zip" ' zip 文件路径

    targetDir = "D:\qita" ' 解压缩目标目录

    result = "" ' 用于存储解压缩结果的变量

    On Error Resume Next ' 忽略错误

    Call UnzipFile(zipFile, targetDir) ' 解压缩文件

    If Err.Number = 0 Then ' 解压缩成功

        result = "解压缩成功！"

    Else ' 解压缩失败

        result = "解压缩失败，错误号：" & Err.Number & "，错误消息：" & Err.Description

    End If

    MsgBox result ' 显示解压缩结果

End Sub