'treeコマンドの結果から各階層までの結果を抽出するスクリプト

Option Explicit 

'ファイルドロップ共通モジュール　起動条件で分岐してメイン処理を呼ぶ
call FileDrop()

'ファイルをドロップした場合
sub Main_File(strFullName)

    if right(strFullName, 4) <> ".txt" then call errorEnd("txt以外のファイルは対応していません。")

    dim  FSO:   Set FSO = CreateObject("Scripting.FileSystemObject")
    Dim inputFile:  Set inputFile = FSO.OpenTextFile(strFullName, 1, False, 0)
    dim strHead
    strHead = inputFile.ReadLine        '1,2行目は不要なので読みだして捨てる
    strHead = inputFile.ReadLine
    strHead = inputFile.ReadLine	'3行目をタイトルとして使用

	'出力フォルダは、ファイルと同じ階層にoutputフォルダを作る
    Dim outPath:      outPath = getPath(strFullName)  & "output\"
    call makeFolder(outPath)

	'出力ファイル名は、フルパスをベースに拡張子の前に_LV1〜LV4とする。
	dim pPos : pPos = instrrev(strFullName,".")
	dim yPos : yPos = instrrev(strFullName,"\")
	dim outName : outName = mid(strFullName,yPos+1,pPos-yPos)
    dim outName1	:	outName1 = outName & "_LV1.txt"
    dim outName2	:	outName2 = outName & "_LV2.txt"
    dim outName3	:	outName3 = outName & "_LV3.txt"
    dim outName4	:	outName4 = outName & "_LV4.txt"

    dim outputFile1 : set outputFile1 = FSO.OpenTextFile(outPath & outName1 , 2, True)
    dim outputFile2 : set outputFile2 = FSO.OpenTextFile(outPath & outName2 , 2, True)
    dim outputFile3 : set outputFile3 = FSO.OpenTextFile(outPath & outName3 , 2, True)
    dim outputFile4 : set outputFile4 = FSO.OpenTextFile(outPath & outName4 , 2, True)

        	outputFile1.write strHead & "（1階層まで）" & chr(10)
        	outputFile2.write strHead & "（2階層まで）" & chr(10)
        	outputFile3.write strHead & "（3階層まで）" & chr(10)
        	outputFile4.write strHead & "（4階層まで）" & chr(10)

	'読みだした文字列の階層を判定して書き込む
	dim textLine
    Do Until inputFile.AtEndOfStream
		textLine = inputFile.ReadLine
		if getTreeLV(textLine) = 1 then 
        	outputFile1.write textLine & chr(10)
        	outputFile2.write textLine & chr(10)
        	outputFile3.write textLine & chr(10)
        	outputFile4.write textLine & chr(10)
		elseif getTreeLV(textLine) = 2 then 
        	outputFile2.write textLine & chr(10)
        	outputFile3.write textLine & chr(10)
        	outputFile4.write textLine & chr(10)
		elseif getTreeLV(textLine) = 3 then 
        	outputFile3.write textLine & chr(10)
        	outputFile4.write textLine & chr(10)
		elseif getTreeLV(textLine) = 4 then 
        	outputFile4.write textLine & chr(10)
		end if
    Loop

    inputFile.Close' バッファを Flush してファイルを閉じる
    outputFile1.Close' バッファを Flush してファイルを閉じる
    outputFile2.Close' バッファを Flush してファイルを閉じる
    outputFile3.Close' バッファを Flush してファイルを閉じる
    outputFile4.Close' バッファを Flush してファイルを閉じる
    set FSO = nothing

end sub

function getTreeLV(textLineU)
	'instrBやmidBは、半角スペースが２バイトとして処理されるので、半角２文字を全角１文字に変換して処理
	dim textLine : textLine = replace(textLineU,"  ","　")
	dim LV : LV = 0
	if mid(textLine,2,1) = "─" then
		 LV = 1
	elseif mid(textLine,2,1) = "　" then
		if mid(textLine,4,1) = "─" then
			 LV = 2
		elseif mid(textLine,4,1) = "　" then
			if mid(textLine,6,1) = "─" then
				 LV = 3
			elseif mid(textLine,6,1) = "　" then		
				if mid(textLine,8,1) = "─" then
					 LV = 4
				end if
			end if
		end if
	end if
	getTreeLV = LV
end function


Function getPath(strFullName)  
    dim fileName    :   fileName = getFileName(strFullName)
    dim filePath    :   filePath =left(strFullName,len(strFullName)-len(fileName))
    getPath = filePath
end function

Function getFileName(FileName )
    Dim yPos
    yPos = InStrRev(FileName, "\")
    If yPos <> 0 Then
    getFileName = Right(FileName, Len(FileName) - yPos)
    Else
    getFileName = ""
    End If
End Function


'ファイルドロップ共通'-----------------------------------------------------------ここから
sub FileDrop
    'ファイルドロップ共通モジュール　ファイルならメイン処理を呼ぶ
    dim strFileName, strFullName

    If WScript.Arguments.count = 0 then    '引数なし
        call Main_noFile()
    else    '引数ありの場合
        with CreateObject("Scripting.FileSystemObject")
        for each strFullName In WScript.Arguments

            If .FolderExists(strFullName) then ' is folder.
                call Main_Folder(strFullName)
            ElseIf .FileExists(strFullName) then' is file.
                Call Main_File(strFullName)
            else      ' is unknown.
                call errorEnd("謎のデータがドロップされました。終了します。")
            End If
        Next
        end with
    end if
    msgbox "階層別の結果をoutputフォルダに出力しました。"
end sub

sub Main_noFile()'VBSを直接実行した場合
    call errorEnd("Treeコマンドの結果ファイルをドラッグドロップしてください。")
end sub

sub Main_Folder(strFullName)'フォルダをドロップした場合
    call errorEnd("フォルダは対象外です。Treeコマンドの結果ファイルをドラッグドロップしてください。")
end sub
'ファイルドロップ共通'-----------------------------------------------------------ここまで

'フォルダがなければ作る。あればメッセを出す
sub makeFolder(DirName)
    dim objFS,str_path
    ' ファイルストリーム・オブジェクト生成
    Set objFS = CreateObject("Scripting.FileSystemObject")
     
    If objFS.FolderExists(DirName) Then
         'msgbox "すでにフォルダが存在します"
    else
         ' フォルダを生成する
         str_path = objFS.CreateFolder(DirName)
    end if
end sub

'エラーメッセージを表示して終了する
sub ErrorEnd(msg)
    set FSO = nothing
    WScript.Echo msg
    WScript.Quit
end sub