VBA zipファイルの作成

(1)作業環境
Windows 7 Professional SP1
Intel(R) Core(TM) i3­3240 CPU @ 3.40GHz 4.00GB
32ビットオペレーティングシステム
Microsoft Office Standard 2010
Excel ver.14


(2)やりたいこと
3つのファイルのzipファイルを同じフォルダに作成したい
　　C:\temp\a.txt
　　C:\temp\b.txt
　　C:\temp\c.txt
　　から
　　C:\temp\d.zip
　　を作りたい。


(3)状況
下記サイトを参照しましたが知識不足で正確にわからないのと、『本当にこんなに長いコードが必要なのか？』と疑問に思っています。

　参考①VBAでZIP圧縮する。
　http://scripting.cocolog-nifty.com/blog/2007/11/ …

　参考②ファイル/フォルダをzipファイルに圧縮
　http://qiita.com/kou_tana77/items/72346c69107fab …

定義、ループ、分岐など基本的なことは分かっています。
APIやFSOなども詳しくはないですが、知っています。
たとえば①の「fso.*******」、「Shell.*******」などの、*******が分かりません。


(4)質問事項
余計なものは除いて必要最低限のコードだけにするとどのようになるかしりたいです。
※エラー処理などに関しては使用環境にあわせて作成します。


ご存じの方ご教示くださいm(_ _)m

質問者からの補足コメント

• ありがとうございます。
  ここに掲載するときは見やすいように外しちゃいましたが、実際は上記の待つ作業ないとエラーになりました。
  
  回答いただいたマクロをもとに実用箇所にアレンジすることができました。
  ありがとうございました^_^

  No.2の回答に寄せられた補足コメントです。 補足日時：2016/01/26 20:23

No.2 回答者： siffon9 回答日時： 2016/01/26 18:14

No.1です。

> .Write "PK" & Chr(5) & Chr(6) & String(18, 0)
> は何をしているのかも教えていただけないでしょうか？

ZIPファイルの終端レコードを示すデータを新規作成したファイルに書き込んでいます。
これにより作成したファイルが「空のZIPファイル」と認識されるようになります。


あと気になったのですが
お礼をいただいた中のソースにファイル一つずつのコピー（圧縮）終了を待つ記述（下記）がありません。
この記述が無いとZIPファイルに複数の被圧縮ファイルを追加する際に取りこぼしが生じる可能性があります。


count = 0
For Each file In files
count = count + 1
zipFolder.CopyHere (sfo.GetAbsolutePathName(CStr(file)))
'このファイルのコピーが終わるまで待つ。
Do Until zipFolder.Items().count = count
Application.Wait Now + TimeSerial(0, 0, 1)
Loop
Next

この回答へのお礼

今携帯から投稿していて、サイトがかなり使いづらく補足というところに記入してしまいました。

本当はここに記載する内容でした。
ありがとうございました。、

お礼日時：2016/01/26 20:26

No.1 ベストアンサー 回答者： siffon9 回答日時： 2016/01/21 18:31

こんな感じでしょうか？

・既に圧縮書庫ファイルが存在する場合は上書きされます。
・指定した被圧縮ファイルが存在しなかった場合はハングアップします。

-----------------------------
Sub MakeZip()
Dim sfo As Object, app As Object
Set sfo = CreateObject("Scripting.FileSystemObject")
Set app = CreateObject("Shell.Application")

Dim zipFolder As Object
Dim file As Variant
Dim count As Long

Const zipFile = "C:\excel\圧縮.zip" '圧縮書庫ファイルの絶対パス
Dim files As Variant
files = Array("C:\excel\あ.txt" _
, "C:\excel\い.txt" _
, "C:\excel\う.txt") ' 圧縮するファイルの絶対パス

'空のzipファイルを作成する
With sfo.CreateTextFile(zipFile, True)
.Write "PK" & Chr(5) & Chr(6) & String(18, 0)
.Close
End With
Set zipFolder = app.Namespace(sfo.GetAbsolutePathName(zipFile))

'zipファイルに圧縮対象のファイルをコピーする
count = 0
For Each file In files
count = count + 1
zipFolder.CopyHere (sfo.GetAbsolutePathName(CStr(file)))
'このファイルのコピーが終わるまで待つ。
Do Until zipFolder.Items().count = count
Application.Wait Now + TimeSerial(0, 0, 1)
Loop
Next
Set sfo = Nothing
Set app = Nothing
Set zipFolder = Nothing
End Sub

この回答へのお礼

ありがとうございます。
必要な分のみを書き出すと、
-----------------------------
　'空のzipファイルを作成する
　With sfo.CreateTextFile("C:\temp\d.zip", True)
　　.Write "PK" & Chr(5) & Chr(6) & String(18, 0)
　　.Close
　End With
　Set zip = app.Namespace(sfo.GetAbsolutePathName("C:\temp\d.zip"))
　'作成したzipファイルにファイルをコピー
　zip.CopyHere (sfo.GetAbsolutePathName("C:\temp\a.txt"))
　zip.CopyHere (sfo.GetAbsolutePathName("C:\temp\b.txt"))
　zip.CopyHere (sfo.GetAbsolutePathName("C:\temp\c.txt"))
-----------------------------
ということですね！
とてもシンプルになり、これでいろいろアレンジして使用できます。
ベストアンサーにしたいのですが、ついでに
.Write "PK" & Chr(5) & Chr(6) & String(18, 0)
は何をしているのかも教えていただけないでしょうか？

お礼日時：2016/01/26 13:05