' **********************************************
' フォルダ内のフォルダを全て列挙
' **********************************************

Dim Buff()
Dim Shell,Fs,obj,objSub,i,nCnt

' **********************************************
' 初期化関数
' **********************************************
Function InitBuff()
	Redim Buff(0)
End Function
' **********************************************
' セット関数
' **********************************************
Function SetBuff(strValue)
	if IsEmpty( Buff(0) ) then
		Buff(0) = strValue
	else
		ReDim Preserve Buff(Ubound(Buff)+1)
		Buff(Ubound(Buff)) = strValue
	end if
End Function

InitBuff

' **********************************************
' フォルダ選択
' **********************************************
Set Shell = CreateObject( "Shell.Application" )
Set obj = Shell.BrowseForFolder( 0, "フォルダ選択", 0, 0 )
if not obj is nothing then
	SetBuff obj.Items().Item().Path
else
	Set obj = Nothing
	Set Shell = Nothing
	Wscript.Quit
end if
Set obj = Nothing
Set Shell = Nothing

' **********************************************
' 列挙
' **********************************************
Set Fs = CreateObject( "Scripting.FileSystemObject" )

nCnt = 0
i = 0
Do While i <= nCnt
	Set obj = Fs.GetFolder(Buff(i))
	on error resume next
	For Each objSub in obj.SubFolders
		if Err.Number = 0 then
			Err.Clear
			SetBuff objSub.Path
			nCnt = nCnt + 1
		end if
	Next
	on error goto 0
	Set obj = Nothing
	i = i + 1
Loop

Set Fs = Nothing

' **********************************************
' 結果出力
' **********************************************
Wscript.Echo Join( Buff, vbCrLf )