Windowsでフォルダー内にある複数のファイルを”最終更新日＋元ファイル名”にリネームし、個別にZip圧縮するスクリプトを組みたいと考えています。知恵をお貸しください。

c:￥sourcefolderにもとのファイルがあり

c:￥sourcefolder￥zippedに出力するとします。

すると下記のコードをvbsファイルコピーして（「”」は半角に直して）実行すると・・・・あら不思議出来てしまいました。。

dim fso, wShell, sourceFolderPath, targetFolderPath, Shell, ie, file, d

dim sourceFolder, TargetFolder, sourceFile, zipfile, zip, dFolder

dim ZIPdata:ZIPdata=”PK” & Chr(5) & Chr(6) & String(18,0)

sourceFolderPath=”C:￥SourceFolder”

targetFolderPath=”C:￥SourceFolder￥zipped”

Set fso=CreateObject(”Scripting.FileSystemObject”)

Set wShell=CreateObject(”WScript.Shell”)

CreateObject(”WScript.Shell”).Run ”explorer.exe”,0,True

WScript.Sleep 100

Set Shell=CreateObject(”Shell.Application”)

For Each ie In Shell.Windows

If Not ie.Busy and ie.ReadyState=4 and InStr(TypeName(ie.Document),”IShellFolderViewDual”)=1 Then

exit for

end if

next

Set Shell=ie.Document.Application

set sourceFolder = fso.GetFolder(sourceFolderPath)

set targetFolder = fso.GetFolder(targetFolderPath)

for each file in sourceFolder.Files

d = file.DateLastModified

zipfile=targetFolderPath & ”￥” & Year(d) & ”-” & Month(d) & ”-” & Day(d) & ” ” & file.Name & ”.zip”

fso.CreateTextFile(zipfile).write ZIPdata

Set dFolder=Shell.NameSpace(zipfile)

Set Folder=Shell.NameSpace(file.ParentFolder.Path)

Set FolderItem=Folder.ParseName(file.Name)

dFolder.CopyHere FolderItem

next

フリーウェアのコードを一部拝借するのは著作権違反ですかねぇ。。もちろんWindowsのZIP機能を使わなくてもコマンドラインで動くZIPユーティリティを組み合わせても十分できるのですけど、VBSだけでできるというのはエレガントですね。