[VBA]標準機能のみでパス付zipファイルの解凍

Question

いつもこちらの識者の皆様にはお世話になっております。
VBAのことで質問させてください。

環境はwindows7 Pro
Excel2010(14.0.7128.5000) 32bit
です。

掲題のとおり、パスワード付のzipファイルを解凍しいたいのですが、調べてもやり方が分からず困っています。

■やりたいこと
外部アプリケーションを使わずにWindows7の標準機能のみで"C:\aaa\bbb.zip"をパスワード"111"で解凍する

会社で使っているのですが、アプリケーションのインストールが禁止されており、
毎日複数のパスワード付zipファイルを手動で解凍して処理をしています。
効率を考えVBAで処理したいのですが、どなたか上記内容の場合どのようなコードが適しているか
教えていただけませんでしょうか。
よろしくお願いいたします。

WindFaller · Accepted Answer

こんばんは。
>>ついでに、その掲示板の質問者さんは、・・・
>実はこの質問も僕なんです。
失礼しました。気が付きませんでした。（^^;

>zipfldr.dllで圧縮・解凍処理をしてるんですね。
これが、私には使いこなせなかったのです。それで、試行錯誤の上、結局、Shell.Application で任せてしまいました。(おそらく、古い環境では動きません)

>ひとまず単一のパス付きzipファイルを解凍するコードをご教示いただければありがたいです。
実に、へんてこなコードですが、試してみてください。こちらの環境ではうまくいきましたが、他人の環境では、失敗する可能性が結構あります。Sendkeyは、Win32 API関数の方が確実ですが、仰々しくなってしまいます。

'//
Sub OneZipExtract()
　Dim fn As Variant
　Dim DestFolder As Variant
　Dim objZip As Variant
　'出来る限り、VBEditor は閉じていたほうがSendkeyの誤動作から免れます。
　Const PSWD As String = "000" 'パスワード
　DestFolder = "C:\aaa\" '展開フォルダ　末尾は、￥(セパレータ)を置くようにしてください。
　
'　fn = Application.GetOpenFilename("ZIPファイル*.zip(*.zip),*.zip")
'　If VarType(fn) = vbBoolean Then Exit Sub
　fn ="C:\aaa\bbb.zip" 　'キメウチ・ファイル名
　' DestFolder = Mid(fn, 1, InStrRev(fn, "\")) '展開ファルダが、ZIPファイルのある場所の場合
　Set objShell = CreateObject("Shell.Application")
　Set objZip = objShell.Namespace(fn).Items
　Application.SendKeys PSWD & "{Enter}"
　objShell.Namespace(DestFolder).CopyHere (objZip)　'*
　Set objShell = Nothing
End Sub
'//

*確実にZIPファイルが展開できたかは、このようにすると良いです。
　ret = objShell.Namespace(DestFolder).CopyHere(objZip)
　If ret > 0 Then
　　　MsgBox "失敗しました。", 48
　End If

WindFaller · Answer

こんにちは。

>DestFolderやobjShellなどの変数への代入あとSendKeysとなっているのですが、なぜこれで処理が可能なのかがわかりません。
これらは、経験則のです。なぜかよく分かりませんが、論理的に逆にすると働くようです。
もしかしたら、バージョンの違いがあるかもしれませんし、将来は、変わるのかもしれませんが、ここ10年、そんな調子です。
たぶん、SendKeyとコードのタイミングの時間差なんだろうと思います。

うまくいかない時は、Win32 API関数を使えば確実です。
ただ、最近、ここの掲示板で書くぐらいで、ほとんど関数名を忘れてしまいました。

>直前のSet objZip = objShell.Namespace(fn).ItemsはobjZipにfnで指定したzipファイルの情報をItemsに取得しただけではないのでしょうか？
Items の中身をみると、そこにコマンドがありますから、そのコマンドを働かせるためのオブジェクトだと思っています。

>変数objShellはobjectの宣言で問題ないでしょうか？
抜けていましたね。元は入っていたのですが、掲示板に出す時に抜かしてしまいました。なお、他のObject に関しては、なるべく、Variant 型にしてください。

>retを使用する場合の宣言はlongでいいですか？
はい、その通りです。

>retという変数をよく見るのですが、これはreturnか何かの略なんでしょうか？  
戻り値で、英語では、Return なのですね。他に、丸める(四捨五入)というのは、Roundなんです。これらは、英語から来ているようです。

なお、前回のzipfldr.dllは、圧縮ツール(expLzh)が邪魔をしていることが分かり、それをアンイントールして、もう一度やってみましたが、結局、圧縮フォルダの展開までで、その後の段階は手動になってしまうようです。もう少し詳しいことが分かれば使えるのかもしれません。
それにつけても、Unzip32.dllがあれば、と思いました。

WindFaller · Answer

こんにちは。

>（System32フォルダにUnzip32.dllがありませんでした。）
「Windows 7では、標準機能としてZIP形式やLZH形式のファイルを展開できます。」121.ware.com より

http://oshiete.goo.ne.jp/qa/7244081.html
やっとここで見つけました。
zipfldr.dll だということですね。
C:\Windows\winsxs\　辺りにあることが分かりました。
検証しますから、少し、お待ちください。

>1つずつzipファイルを右クリック→展開
これは、まとめてUnzipするということでよいのですね。パスワードは同じですか？

なお、
>未インストールですが圧縮・解凍ソフトは唯一+Lhacaのみ認められているようです。
私自身、+Lhacaは、使わざるを得ない場合にのみ使わされる、と言って過言ではありません。そうでない時は、私自身は、あまり初心者用の解凍ツールは使いません。それをインストールすることにより、それに関する「縛り」が強くなるからです。慣れてしまえば良いのですが。

>+LhacaでもVBAでパス付きzipを解凍できませんでしょうか。
http://okwave.jp/qa/q8199975.html
ここの内容は、正直なところ、VBAとしては、あまり興味の沸かないコードだと思います。たぶん、ご質問者さんの、右クリックと差はありません。上記で書いたように、+Lhacaは初心者用のツールで、解凍ツール自体は統合されていたような気がしますから、あまりVBA/VB向きではないような気がします。やむを得ないというところでしょうか。

このベストアンサーの方は、定評のあるよく知られた人物で、私が仮に作っても、結果的には大きな違いはないはずです。

ついでに、その掲示板の質問者さんは、
「WinzipであればVBAとの親和性が高く、業務効率化に多大な貢献を与えるとして、」
言うほどのことはありませんね。（^^;　昔は、お金を払ってまで購入しましたし、私もその一人だったけれども、Lhaなどが出てきて、日本の圧縮事情の変わってしまいました。

また、返事つけます。

WindFaller · Answer

#1の回答者です。
検索し、訂正してください。ほとんど重要ではない部分ですが、残骸やエラーを発生させるものです。

'　　　Debug.Print FileOpt 'コメントブロックにしておいてください。制作段階で監視するためだけです。
　　Else
'　　　FileOpt = "-x " & Fn & " " & OFolder　'これはパスワードなしのものです。
　　　FileOpt = "-x -P" & mPSWD & " " & Fn & " " & OFolder
　　End If

WindFaller · Answer

こんばんは。

>アプリケーションのインストールが禁止されており、
>毎日複数のパスワード付zipファイルを手動で解凍して処理をしています。
System32 に、Unzip.dll ライブラリはあるということでしょうね。

以下は、複数のZIPファイルも選択して、それぞれを解凍することが可能です。

'//
'Option Explicit

Private Declare Function UnZip Lib "unzip32" (ByVal hWnd As Long, ByVal szCmdLine As String, ByVal szOutput As String, ByVal wSize As Long) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Const mPSWD As String = "111"　'パスワード

Sub ZipUnArchive()
　Dim FileNames As Variant
　Dim Fn As Variant
　Dim FileOpt As String
　Dim OFolder As String
　Dim hWnd As Long
　Dim ret As Long
　Dim sOutput As String * 2048
　Const SEP As String = "\"
　hWnd = FindWindow("XLMAIN", vbNullString)
　OFolder = "C:\Users\MyFolder\" '必ず、最後に「\」セパレータを入れること
　'OFolder = Mid(OFolder, 1, InStrRev(OFolder, "\") - 1) & SEP　'ブックの自フォルダ
　
　FileNames = Application.GetOpenFilename("ZIPファイル*.zip(*.zip),*.zip", MultiSelect:=True)
　If VarType(FileNames) = vbBoolean Then Exit Sub
　
　For Each Fn In FileNames
　　
　　If InStr(1, Fn, Space(1)) > 0 Then
　　　FileOpt = "-x -P" & mPSWD & " " & Chr(34) & Fn & Chr(34) & " " & Chr(34) & OFolder & Chr(34)
　　　Debug.Print FileOpt
　　Else
　　　FileOpt = "-x " & Fn & " " & OFolder
　　End If
　　ret = UnZip(hWnd, FileOpt, sOutput, Len(sOutput))
　　sOutput = Left(sOutput, InStr(sOutput, vbNullChar) - 1)
　　If ret <> 0 Then
　　　MsgBox "エラーがあり解凍できませんでした。" & vbCrLf & sOutput, 48
　　Else
　　　Fn = Dir(Fn)
　　　MsgBox OFolder & " に " & Fn & "は正常に解凍しました。"
　　End If
　Next Fn
End Sub
'//

なお、FileOpt　の空白値(スペース)に関して、何度やっても、エラーが出る場合は、ほとんど、その部分です。"My Document"のように空白値があるものは、さらに、Chr(34)で囲っているのですが、オプションの-x の後に空白値も、入れるようにしてください。

[VBA]標準機能のみでパス付zipファイルの解凍

こんばんは。

こんにちは。

こんにちは。

#1の回答者です。

こんばんは。

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング