Windows標準機能を呼び出してZIP圧縮するスクリプト

サーバ管理者をかじってたときに作ったもの。
サーバで動作させてたアプリが吐くログを、圧縮してLTOにバックアップを取る必要に
迫られて。。。

フリーソフトを導入しないでやろうと思ったら、WindowsのOS標準機能を使うしかない
わけで、それでWindowsの持つZIP圧縮機能をVBスクリプトから呼び出して使ってやろう
と思い立ったわけです。

プログラムはVBスクリプト。以下のプログラムをテキストエディタに貼り付けて、
ファイルの拡張子をvbsにしてもらったら動作します。
対象OSはWindows2003/WindowsXPを想定していますが、たぶんWindows2008/Vista/7
でも動作すると思います。（試してないけど・・・テヘペロ）

------------------------------------------------------------------------
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