VBAでZIP展開する。

IE7に対応。

Call ExtractZIP(ZIPファイル,[展開先フォルダ\][ファイル名またはフォルダ名]...)

Option Explicit

Sub ExtractZIP(ZIPfile As String, ParamArray Files() As Variant)
Dim fso As Object
Dim ie As Object
Dim Shell As Object
Dim zFolder As Object
Dim dFolder As Object
Dim Path As Variant
Dim FolderName As String
Dim FileName As String
Dim zFolderItem As Object

Set fso = CreateObject("Scripting.FileSystemObject")
If UCase(fso.GetExtensionName(ZIPfile)) <> "ZIP" Then
  MsgBox "Invalid Extension Name - " & ZIPfile, vbCritical
  Exit Sub
End If
If Not fso.FileExists(ZIPfile) Then
  MsgBox "ZIP file not found. - " & ZIPfile, vbCritical
  Exit Sub
End If
ZIPfile = fso.GetAbsolutePathName(ZIPfile)
'IE7以降も可
Set Shell = CreateObject("Shell.Application")
ZIPfile = Shell.Namespace((ZIPfile)).Self.Path
Shell.ShellExecute "explorer.exe", ZIPfile, , , 0
Do
  For Each ie In Shell.Windows()
    If ie.Visible Then
    ElseIf InStr(TypeName(ie.Document), "IShellFolderViewDual") Then
      If ie.Document.Folder.Self.Path = ZIPfile Then Exit Do
    End If
  Next
  Application.Wait Now + TimeSerial(0, 0, 1)
Loop
'Set ie = CreateObject("InternetExplorer.Application")  'IE7以降ダメ
'Set ie = GetObject("new:{C08AFD90-F2A1-11D1-8455-00A0C91F3880}") 'IE7以降も可
'ie.Navigate ZIPfile
Do While ie.Busy Or ie.ReadyState <> 4
  Application.Wait Now + TimeSerial(0, 0, 1)
Loop
Set Shell = ie.Document.Application
Set zFolder = ie.Document.Folder
If UBound(Files) = -1 Then
  Set dFolder = Shell.Namespace(fso.GetAbsolutePathName(""))
  dFolder.CopyHere zFolder.Items()
ElseIf UBound(Files) = 0 And Right(Files(0), 1) = "\" Then
  Set dFolder = Shell.Namespace(fso.GetAbsolutePathName(Files(0)))
  If dFolder Is Nothing Then
    MsgBox Files(0) & " - Not Found.", vbCritical
  Else
    dFolder.CopyHere zFolder.Items()
  End If
Else
  For Each Path In Files
    FolderName = fso.GetParentFolderName(Path)
    FileName = fso.GetFileName(Path)
    Set dFolder = Shell.Namespace(fso.GetAbsolutePathName(FolderName))
    If dFolder Is Nothing Then
      MsgBox FolderName & " - Not Found.", vbCritical
      Exit For
    End If
    Set zFolderItem = zFolder.ParseName(FileName)
    If zFolderItem Is Nothing Then
      MsgBox FileName & " - Not Found.", vbCritical
      Exit For
    End If
    dFolder.CopyHere zFolderItem
  Next
End If
ie.Quit
End Sub

ZIP展開のFolder.CopyHere()は同期なので、待ち合わせは必要ないけれど、Shell.Applicationだと、展開用の一時フォルダが残るので、Explorer.exeを使います。