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を使います。
« フォームの入力データなどが入った、そのとき実行中のソースを表示する。 | トップページ | ZIPファイルを作成/追加/置換するバッチファイル(その2) »