Excel VBAでファイルやフォルダを圧縮する方法
未読分:2件
昨日以降(0) 2日前以降(0) 3日前以降(0) 4日前以降(0) 5日前以降(0)
近田 伸矢, 植木 悠二, 上田 寛
IEのデータ収集&自動操作のプログラミング本はこの1冊だけ!IEの起動やポップアップウィンドウ、表示を制御する基本的なコードはもちろん、テキストボックスやラジオボタン、表、ハイパーリンクなどのHTML部品を制御する方法など、自動操作に欠かせないノウハウを丁寧に解説。
Message#2 2015年2月6日(金)00時48分 From: 手前味噌 | 返事 削除 変更 |
↓ここのサイトからがっつり持ってきた回答。これでいいんじゃないか? ttp://shiganaisenotes.blogspot.jp/2012/08/windowszip.html Option Explicit '圧縮対象のファイル、フォルダの数-1だけ配列確保 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 |
Message#1 2015年2月6日(金)00時09分 From: vbavba | 返事 削除 変更 |
Excel VBAでファイルやフォルダを圧縮する方法を探しているのですが、解決できなかったため質問させていただきます。 以前にdll(zip32j)を使用してファイルやフォルダを圧縮することはできていたのですが、フォルダを圧縮する際に指定したフォルダパスのツリーごと圧縮してしまうエラーが発生しました。 事例をあげるとC:\Users\user\Desktop\フォルダを指定した場合、フォルダを圧縮したいのに、Usersに含まれるフォルダやファイルが丸ごと圧縮されてしまいます。 こちらの現象はフォルダを圧縮する際に限った話でファイルを指定し圧縮する場合は特に問題はありません。 こちらの原因がまったく分かりませんので、分かる方いましたら、教えてください。 |
昨日以降 2日前以降 3日前以降 4日前以降 5日前以降