Window(XP,2003等)標準機能の「ZIP圧縮・展開」をVBに

質問

Window(XP,2003等)標準機能の「ZIP圧縮・展開」をVBに組み込めますでしょうか？

VBで、圧縮ファイルを展開する、ということをしたいのですが、
ネット上に沢山サンプルがある「外部DLL(unzip32.dllなど)を使用する」という方法は、
使用条件によっては外部DLLのライセンスの問題が絡んでくるようですので、
Windowsの標準機能を組み込めないか？と考えたところです。
Windowsの標準機能、と記載しましたが、
　・ファイルを右クリック→送る→圧縮(zip形式)フォルダ
　・ファイルを右クリック→送る→すべて展開
のことを指しました。

ご指導よろしくお願いいたします。

回答No.3

1050 円（@1050YEN）

>引数「vDestination」がStringだとエラーになるようで、
その通りです。

VBScriptだと逆にStringで切ってあげないといけないのですが、Object以外の型を持つ言語では、Stringで渡すと逆にダメという状態になります。

VBScriptはStringで渡すことによって、最も適したObject型に自動キャストされます。
VBからStringで渡すと、Stringのままオブジェクト扱いされてしまいます。

サンプルは参照設定をしているので、用意されているメソッドが入力候補に現れます。
暇なときにでも、一度試されることをお勧めいたします。

少しのアドバイスでサンプルも見つけ、独自に理解されていくタイプの方のようですね。
スキルの高さを感じました。

がんばってください。

業務放棄の現実逃避者より

回答No.2

1050 円（@1050YEN）

VB6用に作ってみました。
予期せぬ系は無視です。

Private m_objFso As Scripting.FileSystemObject
Private m_objShell As Shell32.Shell

Private Sub Command1_Click()
　　Dim l_colPrm As New Collection
　　l_colPrm.Add ("C:\WINDOWS\しゃくなげ.bmp")
　　l_colPrm.Add ("C:\WINDOWS\シャボン.bmp")

　　Call 圧縮("C:\test.zip", l_colPrm)

　　Call 解凍("C:\test.zip", "c:\")

End Sub

Private Sub Form_Initialize()
　　Set m_objShell = New Shell32.Shell
　　Set m_objFso = New Scripting.FileSystemObject
End Sub
Private Sub Form_Terminate()
　　Set m_objFso = Nothing
　　Set m_objShell = Nothing
End Sub

Private Sub 圧縮(p_strZipPath As String, p_colPrm As Collection)
　　'空ZIP作成
　　Call CreZipNull(p_strZipPath)

　　'書庫に追加していく
　　Call CreZip(p_strZipPath, p_colPrm)
End Sub

Private Sub 解凍(p_strZipPath As String, p_strOutPath)
　　Dim l_objZIP　　　　As Shell32.Folder
　　Dim l_objZIPItem　　As Shell32.FolderItem
　　Dim l_objOut　　　　As Shell32.Folder

　　'書庫オブジェクトを取得する
　　Set l_objZIP = m_objShell.NameSpace(p_strZipPath)

　　'解凍先を取得する
　　Set l_objOut = m_objShell.NameSpace(p_strOutPath)

　　'解凍していく
　　For Each l_objZIPItem In l_objZIP.Items
　　　　Call l_objOut.CopyHere(l_objZIPItem)
　　Next l_objZIPItem
End Sub

Private Sub CreZip(p_strZipPath As String, p_colParams As Collection)
　　Dim l_objZIP　　　　As Shell32.Folder
　　Dim l_objZIPItem　　As Shell32.FolderItem
　　Dim l_strItem　　　 As String
　　Dim l_strName　　　 As String
　　Dim l_intCount　　　As Integer
　　Dim i　　　　　　　 As Integer

　　'書庫オブジェクトを取得する
　　Set l_objZIP = m_objShell.NameSpace(p_strZipPath)

　　'圧縮対象のファイルを取得する
　　For i = 1 To p_colParams.Count
　　　　l_strItem = p_colParams(i)

　　　　'名前を取得する
　　　　l_strName = m_objFso.GetFileName(l_strItem)

　　　　'現在のアイテム数を取得
　　　　l_intCount = l_objZIP.Items().Count

　　　　'書庫への追加を行う
　　　　Call l_objZIP.CopyHere(l_strItem)

　　　　'書庫追加が完了するまで待機
　　　　Do While (l_intCount < l_objZIP.Items().Count)
　　　　　　DoEvents
　　　　Loop
　　Next

End Sub

Private Sub CreZipNull(p_strZipName As String)
　　Call m_objFso.CreateTextFile(p_strZipName, True).Write("PK" & Chr(5) & Chr(6) & String(18, 0))
End Sub

参考URL：

http://okwave.jp/qa/q5807506.html

お礼

1050YEN様、再度ご回答ありがとうございます！！

前回ご回答いただき、今作成し、やっとか出来上がったところでしたので
おしらせしようとしていたところでした。

私が作ったのは、
' Zipファイル展開関数
Function ExtraceZIP(vZipFile As Variant, vDestination As Variant)

Dim objFileSys As Object
Dim objShell As Object
Dim objFile As Object
Dim objDestination As Object

On Error GoTo ZipDeco_Err

' ファイルシステムオブジェクトおよびシェルオブジェクト作成
Set objFileSys = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")

' 対象がZipファイルかチェック
If UCase(objFileSys.GetExtensionName(vZipFile)) <> "ZIP" Then
MsgBox "Invalid Extension Name"
Exit Function
End If

' 展開先パスがなければ作成する
If Dir(vDestination, vbDirectory) = "" Then
MkDir vDestination
End If

' Zipファイルオブジェクト作成
Set objFile = objShell.NameSpace(vZipFile)
' 展開先オブジェクト作成
Set objDestination = objShell.NameSpace(vDestination)

' 展開
' Zipファイルにアーカイブされているファイルが全て展開される
objDestination.CopyHere objFile.Items

On Error GoTo 0

Exit Function

ZipDeco_Err:

MsgBox "Zipファイル展開でエラーが発生しました" & Chr(13) & _
"エラーナンバー：" & Err.Number & Chr(13) & _
"エラー内容：" & Err.Description, vbOKOnly
On Error GoTo 0

End Function

となりました。

オブジェクトを作成するところ
Set objDestination = objShell.NameSpace(vDestination)
の、引数「vDestination」がStringだとエラーになるようで、
それがわからず時間がかかっていました。
なぜかは？？です。

1050YEN様が組んでくださったロジックも調べてみたいと思います。
またご報告いたします！

回答No.1

1050 円（@1050YEN）

VBのばーじょんは？

VBScriptでもできますが。。。

「CopyHere」「ZIP」

これでググると、結構サンプルありますよ。

最近の質問でも上がっています。

お礼

1050YEN様、ご回答ありがとうございます！

VBのバージョンは6.0です。

VBSCriptでもできるのですか！
CopyHereと一緒に調べてみます！

ありがとうございました！