Hinemos Utilityツールからジョブの階層構造を視覚的に表現する

これは完全に自分用のメモ。
しかもまだ完成してなくて、値を仮置きしてある部分も多々あるので鵜呑みにしないでね。

1. Output-Parent-JobId.vbs

Option Explicit

'################
'###  初期部  ###
'################

'*** 引数を取得
Dim cArguments
Set cArguments = WScript.Arguments

'*** 引数が１つ以外の場合は使い方を表示して終了
If cArguments.Count <> 1 Then
    msgbox "単一のHinemos UtilityツールのExcelブックを本スクリプト上にドラッグアンドドロップしてください。" & vbCrLf & "cArguments.Count = " & cArguments.Count,48,"使い方"
    WScript.Quit
Else
    '*** 拡張子でマクロ付きエクセルファイルであることを確認
    If Right(cArguments(0), Len(".xlsm")) = ".xlsm" Then
        Dim sFilePath
        sFilePath = cArguments(0)
    Else
        msgbox "単一のHinemos UtilityツールのExcelブックを本スクリプト上にドラッグアンドドロップしてください。" & vbCrLf & "sFilePath = " & sFilePath,48,"使い方"
        WScript.Quit
    End If
End If


'################
'###  実行部  ###
'################

'*** ExcelアプリケーションでHinemos Utilityツールを開く
Dim AppExcel
Set AppExcel = CreateObject("Excel.Application")
Dim oWorkBook
Set oWorkBook = AppExcel.Workbooks.Open(sFilePath,,True)

'*** Sheet「ジョブデータ」を取得
Dim i, oWorkSheet
For i = 1 To oWorkBook.WorkSheets.Count
    If oWorkBook.WorkSheets(i).Name = "ジョブデータ" Then
        Set oWorkSheet = oWorkBook.WorkSheets(i)
    End If
Next

If IsEmpty(oWorkSheet) = True Then
    oWorkBook.Close(False)
    AppExcel.Quit
    Set AppExcel = Nothing
    msgbox "単一のHinemos UtilityツールのExcelブックを本スクリプト上にドラッグアンドドロップしてください。" & vbCrLf & "ジョブデータSheetが見つかりません。",48,"使い方"
    WScript.Quit
End If

'*** 最大レコード行数を取得
Dim flgLoop : flgLoop = True
Dim iRow    : iRow    = 16 'レコードは17行目から開始
Dim iMax
Do Until flgLoop = False
    iRow = iRow + 1
    If oWorkSheet.Cells(iRow, 2).Value = "" Then flgLoop = False
Loop
iMax = iRow - 1 'レコード無しの行がiRowなので、レコードはこの１行手前まで存在する

'*** ジョブリストを作成
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oLog
Set oLog = fso.CreateTextFile(Left(WScript.ScriptFullName, Len(Wscript.ScriptFullName) - Len(Wscript.ScriptName)) & Wscript.ScriptName & ".list")
For iRow = 1 To iMax - 16
    oLog.WriteLine oWorkSheet.Cells(iRow + 16, 3).Value & "," & oWorkSheet.Cells(iRow + 16, 2).Value
Next

'################
'###  終了部  ###
'################

oLog.Close
Set oLog = Nothing

oWorkBook.Close(False)
AppExcel.Quit
Set AppExcel = Nothing

msgbox "End of script.",,"exit 0"
WScript.Quit

2. Output-PathInfo.vbs

Option Explicit

'################
'###  初期部  ###
'################

'*** 引数を取得
Dim cArguments
Set cArguments = WScript.Arguments

'*** 引数が１つ以外の場合は使い方を表示して終了
If cArguments.Count <> 1 Then
    msgbox "Hinemos Utilityツールから抽出した専用のジョブリストファイルを本スクリプト上にドラッグアンドドロップしてください。" & vbCrLf & "cArguments.Count = " & cArguments.Count,48,"使い方"
    WScript.Quit
Else
    '*** ファイル名で専用のジョブリストファイルであることを確認
    If Right(cArguments(0), Len("01_Output-Parent-JobId.vbs.list")) = "01_Output-Parent-JobId.vbs.list" Then
        Dim sFilePath
        sFilePath = cArguments(0)
    Else
        msgbox "Hinemos Utilityツールから抽出した専用のジョブリストファイルを本スクリプト上にドラッグアンドドロップしてください。" & vbCrLf & "sFilePath = " & cArguments(0),48,"使い方"
        WScript.Quit
    End If
End If

'*** 2次元配列を宣言 (0開始配列)
Dim Ary(5000,2) 'Hinemos Utilityツールの最大レコード数が5000

'*** 0行目はヘッダーとする(処理上は特に意味は無い)
Ary(0, 0) = "Parent"
Ary(0, 1) = "JobID"
Ary(0, 2) = "JobPath"

'*** 専用のジョブリストファイルから情報を取得
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile
Set oFile = fso.OpenTextFile(sFilePath, 1) '読み取り専用
Dim tmpRow : tmpRow = 1
Dim sLine, iMax, tmptmp
Do Until oFile.AtEndOfStream
    sLine = oFile.ReadLine
    tmptmp = Split(sLine, ",")
    Ary(tmpRow, 0) = tmptmp(0)
    Ary(tmpRow, 1) = tmptmp(1)
'    Ary(tmpRow, 0) = Split(sLine,",")
'    Ary(tmpRow, 1) = 1'Split(sLine,"," , 1)
    Ary(tmpRow, 2) = Ary(tmpRow, 0) & "\" & Ary(tmpRow, 1) '各行のJobPathを、ParentとJobIDから算出
    tmpRow = tmpRow + 1
Loop
iMax = tmpRow - 1

'*** 専用のジョブリストファイルの片付け
oFile.Close
Set oFile = Nothing


'################
'###  実行部  ###
'################

'*** αループ処理の間に1件も処理がなかった場合(flgLoopがFalseで戻ってきた場合)にループから抜ける
Dim flgLoop : flgLoop = True
Dim iRow
Do While flgLoop = True

    '*** N週目の処理に入る前にフラグを降ろす
    flgLoop = False

    '*** 配列の1行目から順に処理するループ処理に入る(※αループ)
    For iRow = 1 To iMax

        '*** "JobPath"が"TOP\"から始まる場合は処理をスキップする(ContinueがVBSに無い為の代替措置)
        If Left(Ary(iRow, 2), Len("TOP\")) <> "TOP\" Then

            '*** 全配列から目標を探索するループ処理に入る(※βループ)
            For tmpRow = 1 To iMax

                '*** 処理対象iRow行目のParentが、検索中のtmpRow行目のJobIDにヒットした場合
                If Ary(iRow, 0) = Ary(tmpRow, 1) Then

                    '*** 処理対象iRow行目のJobPathを更新する
                    Ary(iRow, 2) = Left(Ary(tmpRow, 2), Len(Ary(tmpRow, 2)) - Len(Ary(tmpRow, 1))) & Ary(iRow, 2)

                    '*** 更新があったのでフラグを立てる
                    flgLoop = True

                End If

            Next '(※βループ)

        End If

    Next '(※αループ)

Loop

'*** ジョブパスの一覧ファイルを作成
'    このファイルは各行の冒頭に「mkdir C:\」等と挿入すれば、Windows OSでフォルダをジョブの階層構造と同様に作成することができる。
'    これをエクスプローラーやTREEコマンド等を通して見ることで、階層構造を視覚的に表現、把握することができる。
Dim oList
Set oList = fso.CreateTextFile(Left(WScript.ScriptFullName, Len(Wscript.ScriptFullName) - Len(Wscript.ScriptName)) & Wscript.ScriptName & ".list")
For tmpRow = 1 To iMax
    oList.WriteLine Ary(tmpRow, 2)
Next


'################
'###  終了部  ###
'################

oList.Close
Set oList = Nothing

msgbox "End of script.",,"exit 0"
WScript.Quit