同一フォルダ内の特定のファイルを削除するVBScript

・はじめに
　フォルダ内にファイルが大量にあり、そういうフォルダがいくつもあった場合、マニュアルで削除するのが面倒です。そこで、削除するVBScriptを作成しました。削除する条件を修正すれば、ほかの用途でも使えると思います。

・やりたいこと
　デジカメ等の画像データが大量にあり、ビュアーで見るときに90度回転させた画像と、元画像の両方が残っており、それらのファイル名が
元画像 DSC0001.jpg
回転画像 DSC0001-編集済み.jpg
などとなっていました。この元画像は不要なので、すべて削除し、回転画像だけを残したいと考えました。

・方法
　指定のフォルダにあるファイル名をすべて取得し、次の条件を満たすファイルを選び出して、削除します。
今回の条件
１．ファイルXは、ファイル名にキーワードSを含まない
２．ファイルXのベースファイル名を含み、
３．かつ、キーワードSも含むファイル名を持つファイルYが存在する

・追加の要望
　付加的に次のこともできるようにしました。
１．対象のフォルダFを実行時に聞いてくる（当然ですが）。
２．キーワードSを実行時に聞いてくる（当然ですが）。
３．対象のフォルダFとキーワードSは、前回実行時の内容を次回実行時にデフォルトで表示する。

・コード
　以上をもとにスクリプトを作成しました。

option explicit

'sub main
	Const MYEXT = ".ini"

	'前回の条件を読み込む
	dim DestFolder
	dim wd
	ReadCondition DestFolder, wd
	
	'対象のフォルダを入力する
	DestFolder = inputDestFolder(DestFolder)
	
	'このワードを含む類似名のファイルを削除する
	wd = inputWord(wd)
	
	'フォルダ内のファイル名を辞書に取得する
	dim dicFile
	Set dicFile = CreateObject("Scripting.Dictionary")
	set dicFile = GetFiles(DestFolder)
	
	'削除対象のファイルを選定する
	dim dicDel
	Set dicDel = SelectDelFile(dicFile, wd)
	
	'削除してよいか、表示して確認
	ConfirmDel(dicDel)
	
	'削除を実行する
	ExecDel(dicDel)
	
	
	set dicFile = nothing
	set dicDel = nothing
	
	'条件を保存する
	 WriteCondition DestFolder, wd
	
	WScript.Quit
'end sub

'対象のフォルダーを入力する
function InputDestFolder(p)
	dim s 
	s = inputbox("フォルダーをフルパスで入力してください",, p)
	if s = "" then
		WScript.Quit
	end if
	
	InputDestFolder = s
end function

'残すファイルに含まれる文字列を入力する
function InputWord(p)
	dim s 
	s = inputbox("名前が重複している場合、残すファイルに含まれる文字列を入力してください",, p)
	if s = "" then
		WScript.Quit
	end if
	
	InputWord = s
end function

'削除対象ファイルを表示する
sub ConfirmDel(dic)
	
	dim msg
	msg =  "削除対象 " & dic.count & "個" & vbcrlf
	
	dim f
	for each f in dic.keys
		msg = msg & dic(f) & vbCrLf
	next
	wscript.echo msg
	
	dim s
	s = msgbox("削除してよいですか？ ", vbYesNo)
	if s <> vbYes  then
		wscript.quit
	end if
end sub

'削除を実行する
sub ExecDel(dic)
	
	dim fso
	Set fso =  CreateObject("Scripting.FileSystemObject")
	dim f
	for each f in dic.keys
		fso.DeleteFile dic(f)
	next
	set fso = nothing
end sub

'フォルダ内のファイルを辞書に入れる
function GetFiles(df)
	dim fso, dic
	Set dic = CreateObject("Scripting.Dictionary")
	Set fso = CreateObject("Scripting.FileSystemObject")
	
	dim folder
	set folder = fso.GetFolder(df)
	dim f, apn, fn
	for each f in folder.Files
		fn = f.name
		apn = fso.GetAbsolutePathName(f)
		dic(fn) = apn'dic(ファイル名) = フルパスのファイル名
	next
	set GetFiles = dic
	set fso = nothing
	set dic = nothing
end function

'削除対象ファイルを選択する
function SelectDelFile(dicF, wd)
	dim fso, dicD
	Set dicD = CreateObject("Scripting.Dictionary")
	Set fso = CreateObject("Scripting.FileSystemObject")
	
	dim f, bn, ex, fn
	dim f2
	for each f in dicF.keys
		bn = fso.GetBaseName(f)
		ex = fso.GetExtensionName(f)
		
		if instr(1, f, wd) = 0 then'wdを含まないファイルfについて
			for each f2 in dicF.keys
				if instr(1, f2, wd) > 0 then'wdを含んで、かつ
					if instr(1, f2, bn) > 0 then'ベース名を含むファイルf2が存在する場合,fを削除する
						dicD(f) = dicF(f)
						
					end if
				end if
			next
		end if
	next
	set SelectDelFile = dicD
	set dicD = nothing
	set fso = nothing
end function

'処理した条件をファイルに保存する
sub WriteCondition(fld, wd)
	dim fso
	Set fso = CreateObject("Scripting.FileSystemObject")
	
	dim fn
	fn = GetIniFileName()
	
	dim ts
	set ts = fso.CreateTextFile(fn)
	ts.writeline fld
	ts.writeline wd
	ts.close
	set ts = nothing
	set fso = nothing
end sub

'前回の処理条件をファイルから読み込む
sub ReadCondition(fld, wd)
	dim fso
	Set fso = CreateObject("Scripting.FileSystemObject")
	dim fn
	fn = GetIniFileName()
	
	if fso.FileExists(fn) then
		dim ts
		set ts = fso.OpenTextFile(fn)
		fld = ts.readline
		wd =  ts.readline
		ts.close
		set ts = nothing
	end if
	
	set fso = nothing
end sub

'処理条件を保存するファイル名を与える
function GetIniFileName()
	dim fso
	Set fso = CreateObject("Scripting.FileSystemObject")
	dim myname, myfolder
	myname = WScript.ScriptFullName
	myfolder = fso.getParentFolderName(myname)
	
	dim fn, bn
	bn = fso.GetBaseName(myname)
	fn = myfolder & "\" & bn & MYEXT
	
	GetIniFileName = fn
end function

	

・別用途への応用
　'削除対象ファイルを選択する　function SelectDelFile(dicF, wd)　のファイルの選択方法を変更して、削除対象をDictionaryに記録すればほかのことにも利用できると思います。
dicD(ファイル名) = フルパスのファイル名
として記録することが必要です。削除の時はフルパスのファイル名を利用します。
　削除するファイルが大量の時は、大きなメッセージが出てしまうので、煩わしい場合は
'削除対象ファイルを表示する sub ConfirmDel(dic)
にあるwscript.echo msg　をコメントアウトしてください。

・ご注意
　このスクリプトはファイルの削除を伴いますので、実行する場合は、必要なものまで消してしまわないように注意が必要です。利用、改造は自由にしていただいて構いませんが、自己責任でお願いします。

以上

#VBScript , #ファイルの削除