Option Explicit



'引数を取得

Dim args, arg, argNum

Set args = WScript.Arguments



'引数の数を確認

argNum = args.Count



'引数が１つもなければ

If argNum = 0 Then

	'スクリプトを終了

	Wscript.Echo _

		"このツールの上に対象のファイルをドラック＆ドロップして下さい。"

	WScript.Quit

End If



'For Each arg In args

	arg = args(0)

	'Wscript.Echo arg

'Next



'指定のフォルダ内のファイルを再帰的に検索

Dim FIND_START_FOLDER

'FIND_START_FOLDER = "c:\home\endo\tmp" '探索開始folder

FIND_START_FOLDER = arg



Dim FIND_RESULT_FILE_NAME

'FIND_RESULT_FILE_NAME = "d:\FIND_RESULT.TXT" '探索結果一覧



Dim FIND_RESULT_FILE_OBJ



'現在日時を取得

Dim strNow

Dim strCDate

Dim strCTime



strNow = Replace(Left(Now(),10), "/", "") & Replace(Replace(Right(Now(),8)," ","0"), ":", "")

'Wscript.Echo strNow

strCDate = Left(strNow,8)

strCTime = Right(strNow,6)



'メインサブ

Sub Main()



	Dim objFSO ' FileSystemObject

	Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

	'ツールのパスを取得

	 FIND_RESULT_FILE_NAME = objFSO.getParentFolderName(WScript.ScriptFullName) & "\FIND_RESULT_" & strCDate & "_" & strCTime & ".TXT"

	 'msgbox FIND_RESULT_FILE_NAME

	'refer to http://msdn.microsoft.com/ja-jp/library/ie/cc428044.aspx

	'2=書込用としてopen , True=file新規作成 , -1=unicodeで書込

	'結果出力用ファイルを開く

	Set FIND_RESULT_FILE_OBJ = objFSO.OpenTextFile(FIND_RESULT_FILE_NAME,2,True,-1)

	

	'フィールド名

	'FIND_RESULT_FILE_OBJ.Write("#PATH,SIZE(byte),MODIFY DATE,MODIFY DATE AGE,")

	'FIND_RESULT_FILE_OBJ.Write("ACCESS DATE,ACCESS DATE AGE")

	'FIND_RESULT_FILE_OBJ.WriteLine("")



	'指定フォルダのサブフォルダを検索

	FindFolder objFSO.getFolder(FIND_START_FOLDER)

	

	'結果出力用ファイルを開く

	FIND_RESULT_FILE_OBJ.Close

	'オブジェクトを破棄

	set objFSO = Nothing



End Sub





' フォルダ検索関数

Sub FindFolder(ByVal objParentFolder)

	

	'正規表現用

	Dim objRE1

	Dim objRE2

	Set objRE1 = CreateObject("VBScript.RegExp")

	Set objRE2 = CreateObject("VBScript.RegExp")

	

	'ファイルオブジェクト

	Dim objFS

	Set objFS = WScript.CreateObject("Scripting.FileSystemObject")

	

	objRE1.Pattern = "IMG_*"

	objRE2.Pattern = "P_*"



	Dim objFile

	Dim resultLine

	Dim strMoveFrom

	Dim strMoveTo

	For Each objFile In objParentFolder.Files

		strMoveFrom = objFile.ParentFolder & "\" & objFile.Name

		'Msgbox objFile.Name

		If objRE1.Test(objFile.Name) Then

			strMoveTo = Replace(objFile.Name,"IMG_","")

			strMoveTo = objFile.ParentFolder & "\" & strMoveTo

			objFS.MoveFile strMoveFrom,strMoveTo

		ElseIf objRE2.Test(objFile.Name) Then

			strMoveTo = Replace(objFile.Name,"P_","")

			strMoveTo = objFile.ParentFolder & "\" & strMoveTo

			objFS.MoveFile strMoveFrom,strMoveTo

		Else

			strMoveTo = objFile

		End If

		

		With Err

			Select Case .Number

			Case 5, 52

				MsgBox "ファイル名に使えない文字が指定されたので中断します。"

				Exit For

			Case 58

				MsgBox add_txt & f.Name & " は既に存在するためファイル名を変更できません。"

				.Clear

			Case 0

				'エラーが発生しなかった場合は何もしない

			Case Else

				MsgBox .Description & .Number

				.Clear

			End Select

		End With

		

		'検索結果を出力用ファイルに書き込み

		FIND_RESULT_FILE_OBJ.Write(strMoveTo)

		'FIND_RESULT_FILE_OBJ.Write(objFile.ParentFolder & "\" & objFile.Name & ",")

		'FIND_RESULT_FILE_OBJ.Write(objFile.Size & ",") 'byte

		'FIND_RESULT_FILE_OBJ.Write(objFile.DateLastModified & ",")

		'FIND_RESULT_FILE_OBJ.Write(Fix(Date() - objFile.DateLastModified) & ",")

		'FIND_RESULT_FILE_OBJ.Write(objFile.DateLastAccessed & ",")

		'FIND_RESULT_FILE_OBJ.Write(Fix(Date() - objFile.DateLastAccessed))

		FIND_RESULT_FILE_OBJ.WriteLine("")

	Next

	

	Dim objSubFolder ' サブフォルダ

	

	'サブフォルダを再帰的に検索

	For Each objSubFolder In objParentFolder.SubFolders

		FindFolder objSubFolder

	Next

	

	Set objRE1 = Nothing

	Set objRE2 = Nothing



End Sub





'実行

Main

msgbox "処理が終了しました。"