zip圧縮

Windows標準の zip圧縮機能だと、複数選択して「圧縮（zip 形式）フォルダー」を作成すると、１つの zipファイルになる。
例えば、100個のファイルがあり、それを個別に zipファイルにしたい場合は、連続圧縮やLHAUtirityなどの圧縮ツールか、個別に1つ1つ地道に作業するしかない。

そんな訳で、圧縮ツールを使えない環境でも手軽に個別圧縮ができるようにスクリプトを組んでみました。

Option Explicit

Dim i

Dim fso

Dim Shell

Dim file

Dim dFolder

Dim Folder

Dim FolderItem

Dim ZIPfile:ZIPfile="新規圧縮 (zip 形式) フォルダ.zip"

Dim ZIPdata:ZIPdata="PK" & Chr(5) & Chr(6) & String(18,0)

If WScript.Arguments.Count<1 div="" then="">

    WScript.Echo "Usage: CScript.exe MakeZIP.VBS fileName ...."

    WScript.Quit

End If

Set fso=CreateObject("Scripting.FileSystemObject")

Set Shell=CreateObject("Shell.Application")

For i=0 to WScript.Arguments.Count-1

    Call MakeZIP()

Next

WScript.Quit

Sub MakeZIP()

    ZIPfile=fso.GetAbsolutePathName(WScript.Arguments(i)&".zip")

    If Not fso.FileExists(ZIPfile) Then

         fso.CreateTextFile(ZIPfile,False).Write ZIPdata

    End If

    If i=0 Then 

         WScript.Sleep 1000

    Else

         WScript.Sleep 100

    End If

    file=fso.GetAbsolutePathName(WScript.Arguments(i))

    Set Folder=Shell.NameSpace(fso.GetParentFolderName(file))

    Set FolderItem=Folder.ParseName(fso.GetFileName(file))

    Set dFolder=Shell.NameSpace(ZIPfile)

    dFolder.CopyHere FolderItem

    WScript.Sleep 10

End Sub