質問: [vba]標準機能のみでパス付zipファイルの解凍 いつもこちらの識者の皆様にはお世話になっております。 vbaのことで質問させてください。 環境はwindows7 pro excel2010(14.0.7128.5000) 32bit です。 掲題のとおり、パスワード付のzipファイルを解凍しいたいのですが、調べてもやり方が分からず困っています。 ■やりたいこと 外部アプリケーションを使わずにwindows7の標準機能のみで"c:\aaa\bbb.zip"をパスワード"111"で解凍する 会社で使っているのですが、アプリケーションのインストールが禁止されており、 毎日複数のパスワード付zipファイルを手動で解凍して処理をしています。 効率を考えvbaで処理したいのですが、どなたか上記内容の場合どのようなコードが適しているか 教えていただけませんでしょうか。 よろしくお願いいたします。
回答: こんばんは。 >アプリケーションのインストールが禁止されており、 >毎日複数のパスワード付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 の後に空白値も、入れるようにしてください。