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:homeendotmp"                  '探索開始folder

FIND_START_FOLDER = arg



Dim FIND_RESULT_FILE_NAME

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

Dim FIND_RESULT_FILE_OBJ





Sub Main()

	

	Dim objFSO          ' FileSystemObject

	

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

	'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

	Dim objFS

	Set objRE1 = CreateObject("VBScript.RegExp")

	Set objRE2 = CreateObject("VBScript.RegExp")

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

	objRE1.Pattern = "IMG_*"

	objRE2.Pattern = "P_*"

	

	Dim objFile

	Dim resultLine

	Dim strMoveFrom

	Dim strMoveTo

	Dim f

	

	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

			'objFile.DeleteFile strMoveFrom,strMoveTo

		ElseIf objRE2.Test(objFile.Name) Then

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

			strMoveTo = objFile.ParentFolder & "" & strMoveTo

			objFS.MoveFile strMoveFrom,strMoveTo

			'objFile.DeleteFile 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 "終了しました。"