'*********************************************************
' ファイルを別名で保存します。
' ファイルを名を　filelist.txt → filelist.vbs　に変更します。
'
'************************************************************
Dim WshShell, oExec
Set WshShell = CreateObject("WScript.Shell")
Msgrc = Msgbox("ファイル一覧の作成をします。" ,vbYesNo,"ファイル一覧作成")
If Msgrc = vbYes Then
	Set oExec = WshShell.Exec("cmd.exe /c dir /s /b> file_list.txt")
	Msgrc = Msgbox("ファイル一覧を作成しました。",vbokonly)
End if


'************************************************************
'	ファイル一覧作成プログラム
'	Ver 0.8 '06/07/21 Noboru kawahara
'************************************************************
Dim fso, f, s, fname, fdate, ftime, fsize
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder("./")
Msgrc = Msgbox("ファイルの一覧を作成をします。" ,vbYesNo,"ファイルの一覧作成")
Msgr2 = Msgbox("サブフォルダーも含めますか？。" ,vbYesNo,"サブフォルダ確認")
'************************************************************
If Msgrc = vbYes Then
	' ファイルを作成します。
	Set fcnt = fld.Files
	Set FilD = fso.CreateTextFile("./file_list.txt", True)
	kugiri = chr(9)
	For Each fcn1 in fcnt
		C02 =Instr(1, fcn1.name, "file_list", 1)
		if C02 = 0 Then 
			call Get_name(fcn1.name,"")
		end if
	Next
	'************************************************************
	'　サブフォルダーを含める場合
	'************************************************************
	If Msgr2 = vbYes Then
		set sf = fld.SubFolders
		For Each fcnsub in sf
			Set flsub = fso.GetFolder(".\" & fcnsub.name & "\")
			Set fcnt = flsub.Files
			if fcnsub.name <> oboe Then
				FilD.Write Chr(13) & Chr(10)
				FilD.Write "--- " & fcnsub.name & " ---" & Chr(13) & Chr(10)
				oboe = fcnsub.name
			end if
			For Each fcn1 in fcnt
				call Get_name(fcn1.name,fcnsub.name)
			Next
		Next
	end if
	FilD.Close
	Msgrc = Msgbox("ファイル一覧を作成しました。",vbokonly)
End if
'***********************
'  subroutine 
'***********************
sub Get_name(fname,fsubname)
	if fsubname = "" Then
		Set f = fso.GetFile(fname)
	else
		Set f = fso.GetFile(".\" & fsubname & "\" & fname)
	end if
	s = f.DateCreated			'ファイル作成日時を取得します。
	fdate = left(s,10)
	ftime =	right(s,8)
	fname = UCase(fname)	'大文字にします。小文字は LCase
	FilD.Write fname & kugiri & fdate & kugiri & ftime & Chr(13) & Chr(10)
end sub
'************************************************************
'その他の情報
'ファイルサイズ　                 f.size
'ファイルタイプ                   f.type
'最後にアクセスされた日付と時刻   f.DateLastAccessed
'最後に更新されたときの日付と時刻 f.DateLastModified
'格納されているドライブの名前　   f.Drive
'************************************************************