rem フォルダ選択画面で選択した任意のフォルダ内のフォルダリストを

rem 現在時刻を付加したCSV形式で既定のフォルダに保存する。

rem 参考

rem http://www.whitire.com/vbs/

rem tips0045.vbs

rem tips0067.vbs

rem tips0082.vbs

rem tips0124.vbs



Option Explicit

On Error Resume Next



Dim objShell    ' Shell オブジェクト

Dim objFolder   ' フォルダ情報

Dim objFSO      ' FileSystemObject

Dim objFile     ' ファイル書き込み用

Dim objWinFolder    ' ウィンドウズフォルダ



' フォルダ検索関数

Sub FindFolder(ByVal objMainFolder, ByVal strTab)

	Dim objSubFolder    ' サブフォルダ

	For Each objSubFolder In objMainFolder.SubFolders

		rem WScript.Echo strTab & "　  " & objSubFolder.Name

		objFile.WriteLine(strTab & objSubFolder.Name)

		FindFolder objSubFolder, "," & strTab

	Next

End Sub





Function TimeStamp() 

	Dim dtmNowDate  ' 現在時刻

	dtmNowDate = Now()

	TimeStamp = _

	Year(dtmNowDate) & _

	Right("0" & Month(dtmNowDate), 2) & _

	Right("0" & Day(dtmNowDate), 2) & _

	Right("0" & Hour(dtmNowDate), 2) & _

	Right("0" & Minute(dtmNowDate), 2) & _

	Right("0" & Second(dtmNowDate), 2)

End Function





'フォルダ取得

Set objShell = WScript.CreateObject("Shell.Application")

If Err.Number = 0 Then

	Set objFolder = objShell.BrowseForFolder(0, "通常", 0)

	If Not objFolder Is Nothing Then

		rem WScript.Echo objFolder.Items.Item.Path



		'フォルダリスト作成

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

		If Err.Number = 0 Then

			rem Set objWinFolder = objFSO.GetSpecialFolder(1)

			Set objWinFolder = objFSO.GetFolder(objFolder.Items.Item.Path)

			WScript.Echo objWinFolder.Path & vbCrLf &"のフォルダリストを作成します。"

			Set objFile = objFSO.OpenTextFile("D:\" & TimeStamp & "list.csv", 2, True)

			If Err.Number = 0 Then



				FindFolder objWinFolder, ""



			Else

				WScript.Echo "ファイルオープンエラー: " & Err.Description

			End If

			objFile.Close

		Else

			WScript.Echo "エラー: " & Err.Description

		End If

	Else

		WScript.Echo "エラー: " & Err.Description

	End If





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



	Set objWinFolder = Nothing

	Set objFSO = Nothing



	REM    Set objFolder = objShell.BrowseForFolder(0, "Ｃドライブ", 0, "C:\")

	REM    If Not objFolder Is Nothing Then

	REM        WScript.Echo objFolder.Items.Item.Path

	REM    End If



	REM    Set objFolder = objShell.BrowseForFolder(0, "スタートメニュー", 0, &HB)

	REM    If Not objFolder Is Nothing Then

	REM        WScript.Echo objFolder.Items.Item.Path

	REM    End If



Else

	WScript.Echo "エラー：" & Err.Description

End If



Set objFolder = Nothing

Set objShell = Nothing





Set objFile = Nothing

Set objFSO = Nothing