http://tuka.s12.xrea.com/index.xcg?p=VBS#p16

	Option Explicit
	'############################################################
	'##　ファイル一覧作成処理	2008/02/19
	'##　（サブフォルダも処理する）
	'############################################################
	'###
	'###    実行情報定義（デバッグ情報）
	'###    true ならデバッグモード
	'###            ログにデバッグ情報が出力されます
	'###            削除はおこなわれません
	'###            起動パラメータ/debug:でデバッグ指定をおこないます
	Public CNS_DEBUG
	CNS_DEBUG = False		'パラメータでも指定可能
	'###
	'###
	Const CNS_LOGDIR = ".\"
	Const CNS_LOGFILE = "FILEList.log"
	'############################################################
	'###    プログラム
	'############################################################
	Dim m_oFs
	Dim m_INCNT, m_MATCHCNT
	Dim m_SubFlg
	Dim m_SizeFlg
	Dim m_DateFlg
	'
	'主処理の実行( 検索対象パス 対象拡張子 間隔 経過月数　）
	'
	'起動パラメータのチェック
	Dim strDir, strSub, strDebug, strDate, strSize
	strDir =  Wscript.Arguments.Named("DIR")
	strDate =  Wscript.Arguments.Named("DATE")
	strSize =  Wscript.Arguments.Named("SIZE")
	strSub =  Wscript.Arguments.Named("SUB")
	strDebug =  Wscript.Arguments.Named("DEBUG")
	If Ucase(Trim(strDebug)) = "ON" Then 
		CNS_DEBUG = True
	End if
	If strDir = "" Then 
		Wscript.Echo "Dir Error"
		Wscript.Quit
	End if
	m_SubFlg = True
	If Ucase(Trim(strSub)) = "OFF" Then 
		m_SubFlg = False
	End if
	m_DateFlg = True
	If Ucase(Trim(strDate)) = "OFF" Then 
		m_DateFlg = False
	End if
	m_SizeFlg = True
	If Ucase(Trim(strSize)) = "OFF" Then 
		m_SizeFlg = False
	End if
	'
	'
	'処理実行
	Call Main(strDir )
	'
	'
	'
	'############################################################
	'==========================================================
	'主処理
	'引数：対象ディレクトリ
	'==========================================================
	function MAIN( DIRNAME )
		Dim OFLD
		Dim inCnt
		Dim outCnt
		Dim dtComp
		Dim lngLevel
	
		set m_oFs = createobject("Scripting.FileSystemObject")
	
		SET OFLD = M_OFS.GETFOLDER(DIRNAME)
	
		CALL LOGWRITE("----start " & NOW )
	
		if CNS_DEBUG = true then 
			CALL LOGWRITE("--Debug=On")
		Else
			CALL LOGWRITE("--Debug=Off")
		end if
		CALL LOGWRITE("--SubDir=" & m_SubFlg )
			
		m_INCNT = 0
		m_MATCHCNT = 0
		lngLevel = 1
		CALL ReMain( OFLD, DIRNAME, lngLevel)
		
		CALL LOGWRITE("--InCnt=" & m_INCNT )
		CALL LOGWRITE("--MatchCnt=" & m_MATCHCNT )
		CALL LOGWRITE("----end " & NOW )
	
		set m_oFs = Nothing 
	end function
	'
	'==========================================================
	'フォルダは再帰処理でファイル検索
	'引数：検索フォルダ、
	'==========================================================
	function ReMain(oFolders, dirname, lngLevel)
		dim oFile
		dim oSubFolder
		Dim sw1 
		'----------------------------------------
		'ファイル名を列挙し、処理を行なう。
		'----------------------------------------
		sw1 = 0
		for each oFile in oFolders.files
			m_INCNT = m_INCNT + 1
			sw1 = sw1 + 1
			m_MATCHCNT = m_MATCHCNT + 1
			Call ProcFile(oFile)
		next
	
		'----------------------------------------
		'サブフォルダーは再帰呼び出しおこなう
		'----------------------------------------
		if m_SubFlg = True Then 
			for each oSubFolder in oFolders.subfolders
				lngLevel = lngLevel + 1 
				Call ReMain(oSubFolder,addsep(dirname) & oSubFolder.name, lngLevel)
				lngLevel = lngLevel - 1 
			next
		End If
	end function
	'
	'==========================================================
	'見つかったファイルはここの記述で処理される。
	'引数：Fileオブジェクト
	'==========================================================
	sub ProcFile(objFile)
		'ログファイル出力
		Dim strWk
		Dim strWk1
	
		strWk1 = left(objFile.Path, len(objFile.Path) - len(objFile.Name) )
	
		strWk = ""
		strWk = strWk & UCASE( objFile.Name )
		If m_SizeFlg <> False Then  
			strWk = strWk & vbTab
			strWk = strWk & objFile.Size
		End If
		IF m_DateFlg <> False Then 
			strWk = strWk & vbTab
			strWk = strWk & objFile.Datelastmodified
		End If
		strWk = strWk & vbTab
		strWk = strWk & UCASE( strWk1 )
		Call LogWrite( strWk )
	
	end sub
	'
	'==========================================================
	'拡張子の取得
	'引数：
	'==========================================================
	function GetExtention(strFname)
		dim Cnt
	
		Cnt = ubound(Split(strFname, "."))
		if Cnt => 1 then 
			' . でスプリットした最後の要素が拡張子
			GetExtention =  Split(strFname, ".")(Cnt) 
		else
			'.が無い場合は拡張子なし
			GetExtention = ""
		end if 
	end function 
	'
	'==========================================================
	'パスセパレータの追加
	'==========================================================
	function addsep(dirname) 
		if right(dirname,1) <> "\" then
			 addsep = dirname & "\"
		end if
	end function
	'
	'==========================================================
	'ログファイルの出力
	'==========================================================
	sub LogWrite( MSG ) 
		dim OOUTF 
		dim strFname
		
		On Error Resume Next
		strFname = CNS_LOGDIR & GetSysDate() & CNS_LOGFILE 
		SET OOUTF = M_OFS.OpenTextFile(strFname ,8,true)
		OOUTF.WRITELINE( Now & vbTab & MSG )
		OOUTF.close
	end sub
	'
	'==========================================================
	'デバッグログファイルの出力(CNS_DEBUG<>0のときのみ出力
	'==========================================================
	sub DebugLogWrite( MSG ) 
		dim OOUTF 
		dim strFname
	
		If CNS_DEBUG = False then
			Exit Sub
		End if 
		Call LogWrite( "<Debug>" & vbTab & MSG )
	end sub
	'
	Function GetSysDate()
		GetSysDate = GetDateFormat( Now() )
	End Function 
	'
	Function GetDateFormat( dtDate )
		Dim strWk 
		strWk = Year( dtDate )
		strWk = strWk & Right("00" & Month( dtDate ),2)
		strWk = strWk & Right("00" & Day( dtDate ),2)
		GetDateFormat = strWk
	End Function 
	'
	'======================================================================
	'Read a profile from .ini file
	'======================================================================
	Private Function GetProfile(strSection, strKey, varDefault, strPathIni)
		GetProfile = varDefault ' Initialize by default
		Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
		Dim f : Set f = fso.OpenTextFile(strPathIni)
		
		Dim strLine
		Dim fSectionFound
		Dim strKeyFound
		fSectionFound = False
		Do While f.AtEndOfStream <> True
			strLine = Trim(f.ReadLine)
			If (strLine <> "") And (Left(strLine, 1) <> ";") Then ' Skip Blank/Comment Line
				' When Key was found
				If fSectionFound = True Then
					If strKey = Left(strLine, InStr(strLine, "=") - 1) Then
						GetProfile = Mid(strLine, InStr(strLine, "=") + 1)
						f.Close()
						Set fso = Nothing
						Exit Function ' Success
					End If
				End If
				' Control inside target section or not.
				If (Left(strLine, 1) = "[") And (Right(strLine, 1) = "]") Then
					If strLine = ("[" + strSection + "]") Then
						fSectionFound = True
					Else
						fSectionFound = False
					End If
				End If
			End If
		Loop
		f.Close()
		Set fso = Nothing
	End Function