WSHでzip解凍＆圧縮

なんか下書きしたまんまの記事があったのであっぷ。
WSHでzipフォルダ内のzipファイルを解凍し、必要なデータだけ抜き出して再圧縮してますね。
社内用ツールとして作った産物なので一部ボカして載せてるので多分ちゃんと動かないと思います。その辺は自己解決よろでっす。

動作確認：WindowsXP SP3

Option Explicit

'---------------------------------------------
'メイン処理
'---------------------------------------------
Call main()
WScript.Quit 0


'---------------------------------------------
'---------------------------------------------
Dim rootPath
Dim zipPath
Dim dataPath
Dim updatePath
Dim workPath

'---------------------------------------------
'メイン関数
'---------------------------------------------
Sub main()
	
	rootPath = Replace(WScript.ScriptFullName,WScript.ScriptName,"")
	zipPath = rootPath & "zip\"
	dataPath = rootPath & "data\"
	updatePath = rootPath & "update\"
	
	With CreateObject("Scripting.FileSystemObject")
		'中間フォルダ作成
		workPath = .BuildPath(rootPath, .GetTempName)
		.CreateFolder(workPath)
		
		'メイン処理
		'zipファイルを軸に***ファイルを補完していく
		Call funcMain(.GetFolder(zipPath))
		
		'中間フォルダ削除
		.DeleteFolder(workPath)
	End With
	
	Msgbox "実行終了"
End Sub


'---------------------------------------------
'メイン処理関数
'---------------------------------------------
'---------------------------------------------
'	IN：	zipファイル格納フォルダ
'---------------------------------------------
Sub funcMain(objTargetFolder)
	Dim objFolder
	Dim objFile
	Dim objDataFolder
	Dim objDataFile
	
	'再帰処理
	For Each objFolder In objTargetFolder.SubFolders
		Call funcMain(objFolder)
	Next
	'@@@DEBUG
	'msgbox objTargetFolder
	
	With CreateObject("Scripting.FileSystemObject")
		For Each objFile In objTargetFolder.Files :Do
			'zipファイルでない場合は繰り返し
			If LCase(.GetExtensionName(objFile.Name)) <> "zip" Then Exit Do
			
			'作業フォルダに解凍
			With CreateObject("Shell.Application")
				.NameSpace(workPath).CopyHere .NameSpace(objFile.path).Items
			End With
			
			'データをコピーする
			For Each objDataFile In .GetFolder(dataPath).Files :Do
				'***ファイルでない場合は繰り返し
				If LCase(.GetExtensionName(objDataFile.Name)) <> "***" Then Exit Do
				
				'作業フォルダにコピー
				'@@@DEBUG
				'msgbox objDataFile.path
				'msgbox workPath
				.CopyFile objDataFile.path, workPath & "\"
			Loop until 1 :Next
			
			'ファイル圧縮
			Call compressFile(Replace(WScript.ScriptFullName, WScript.ScriptName, objFile.Name))
			
			'ファイル移動
			.MoveFile Replace(WScript.ScriptFullName, WScript.ScriptName, objFile.Name) updatePath
			
			'作業フォルダ内のファイルを削除する
			.DeleteFile workPath & "\*"
		Loop until 1 :Next
	End With
End Sub


'---------------------------------------------
'ファイル圧縮処理関数
'---------------------------------------------
'---------------------------------------------
'	IN：	zipファイル名
'---------------------------------------------
Sub compressFile(zipFileName)
	Dim i
	Dim objFile
	Dim strbuf
	Dim aryHex
	
	'zipファイルを作るためのおまじない
	aryHex = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
	For i = 0 To UBound(aryHex)
		strbuf = strbuf & Chr(aryHex(i))
	Next
	
	'zipファイル作成
	With CreateObject("Scripting.FileSystemObject").CreateTextFile(zipFileName, True)
		.Write strbuf
		.Close
	End With
	
	With CreateObject("Scripting.FileSystemObject")
		'フォルダ内のファイルを全て格納
		For Each objFile In .GetFolder(workPath).Files
			CreateObject("Shell.Application").NameSpace(zipFileName).CopyHere(objFile.path)
			
			WScript.sleep 3000
		Next
	End With
End Sub