Excel VBAでファイルやフォルダを圧縮する方法 削除
| Message#2 2015年2月6日(金)00時48分 From: 手前味噌 |
| ↓ここのサイトからがっつり持ってきた回答。これでいいんじゃないか？ ttp://shiganaisenotes.blogspot.jp/2012/08/windowszip.html Option Explicit '圧縮対象のファイル、フォルダの数-１だけ配列確保 Dim files(0) '配列に圧縮対象のパスを絶対パスで定義していく files(0)="圧縮対象とするフォルダを絶対パスで記述" '圧縮ルーチンの呼び出し。 '圧縮後のファイル名及びパスと圧縮対象が格納された配列を渡す。 Call MakeZip("圧縮後のファイル名を絶対パスで記述",files) 'ここから圧縮ルーチン Sub MakeZip(Byval ZipPath, ByRef FileArray) '変数定義 Dim sfo, app, file, num, zipFolder '処理で使用するオブジェクトの初期化 Set sfo=CreateObject("Scripting.FileSystemObject") Set app=CreateObject("Shell.Application") '古い同名圧縮ファイルがあったら削除する。 If sfo.FileExists(ZipPath) = True Then sfo.DeleteFile ZipPath End If '空のzipファイルを作成する With sfo.CreateTextFile(ZipPath, True) .Write "PK" & Chr(5) & Chr(6) & String(18,0) .Close End With '新規作成したzipファイルへ圧縮対象をコピーする num=0 'ZIPファイルのパスを変数に代入して、値（この場合はパス）に変化が 'ないようにする。 Set zipFolder=app.NameSpace(sfo.GetAbsolutePathName(ZipPath)) For Each file In FileArray If CStr(file)<>"" Then file = sfo.GetAbsolutePathName(file) 'Zipフォルダに圧縮対象のファイルをコピーする zipFolder.CopyHere(file) 'ファイル数をカウントアップ num=num+1 End If Next 'すべての圧縮ファイルのコピーが終わるまで待つ。 Do Until zipFolder.Items().Count=num Wscript.sleep 100 Loop Set sfo = Nothing Set app = Nothing End Sub |
上のメッセージを削除します。
よければパスワードを入力し、削除ボタンをクリックしてください。
