'-----------------------------
' トリニティログ収集
' ver. 0.314159265358979323846
' 構成(2020/10/27)
'-----------------------------
' ■関数/Section一覧■
' 1) Global変数セクション // value
' 2) Sub 集計実行() // 集計ボタン・イベント
' 3) Sub Init() // 初期値 ()Global設定とtagシートのcopy)
' 4) Sub MainProc() // main処理
' 5) Function getCh2Name(strLogFileName) // ファイル名の先頭2文字でマスター登録タグかどうか判定
' 6) Function getTagName(strLogFileName) // ファイル名から、タグ名を(tag名またはblankを返却)
' 7) Sub setLogDataByTagName(strTag, strCh2, strFileNameSpec, TextBuff) //ログデータ処理= タグ名シートの、各フィールドへ○付け
' 8) sub newExcelBook() // 結果を新しい日付付きxlsxファイルに保存
' 9) sub addHistory() // 履歴の追記(log-fileリンクも)
'---------------------------------------------------------------------------------------------------------------------------------
'--------------
' // Global変数
'--------------
Option Explicit
'// フォルダ //
Public LogFolder
Public LogFile
Public MenuFolder
Public DeployFolder
'// テーブルデータを初期値投入用 //
Public TagName(4) As String
Public TagCh2(4) As String
Public FldMaster(4) As String
'-----------------
'// 集計ボタン //
'-----------------
Sub 集計実行()
Const FlgDebug = "no"
'// 実行リマインド(リリース時に有効化)
If FlgDebug = "no" Then
If vbYes <> MsgBox("集計を開始しますか?", vbYesNo) Then
Exit Sub
End If
End If
'// 初期処理 (マスターデータ設定値反映) //
Call Init
Call MainProc
End Sub
'--------------------------------------
'// 初期値Global設定とtagシートのcopy
'--------------------------------------
Sub Init()
Dim iCnt
'// [PathMaster]テーブル //
LogFolder = range("LogFolder").Value
LogFile = range("LogFile").Value
MenuFolder = range("MenuFolder").Value
DeployFolder = range("DeployFolder").Value
'// (1)フィールドマスター初期値
iCnt = 1
While iCnt <= 4
FldMaster(iCnt) = range("c25").ListObject.DataBodyRange(iCnt * 2 - 1)
iCnt = iCnt + 1
Wend
'// (2) タグ初期値
iCnt = 1
While iCnt <= 4
TagName(iCnt) = range("c18").ListObject.DataBodyRange(iCnt * 2)
TagCh2(iCnt) = range("c18").ListObject.DataBodyRange(iCnt * 2 - 1)
iCnt = iCnt + 1
Wend
'// (3) タグ名(template)からタグ名シートをcopy作成し、Listのレコード行を空に。
Dim tblData As ListObject
iCnt = 4
While iCnt >= 1
'□ sheetのコピー
Worksheets("template1").Copy After:=Worksheets("★Menu")
ActiveSheet.Name = TagName(iCnt)
'/debug:/ MsgBox "/" & TagName(iCnt) & "/"
'□ リストテーブルの全レコード削除
Set tblData = ActiveSheet.range("A4").ListObject
If Not (tblData.DataBodyRange Is Nothing) Then
tblData.DataBodyRange.Delete
End If
iCnt = iCnt - 1
Wend
End Sub
'-----------------
'// (main) //
'-----------------
Sub MainProc()
On Error Resume Next
Dim fso, pfl, strTag, allbuf, strCh2
'/---------------------
'/ ログフォルダのリストから...
'/---------------------
Set fso = New FileSystemObject
Set pfl = fso.getFolder(LogFolder)
Dim fl As Folder
For Each fl In pfl.SubFolders 'sub folder Layer
' /debug:/ MsgBox (fl.Name & " - " & fl.Path)
strTag = getTagName(fl.Name)
strCh2 = getCh2Name(fl.Name)
If strTag = "" Then '
'// スルー: タグが全部マッチしない場合、無視(by design) //
'/debug:/ MsgBox "NG:" & strTag & "," & fl.Name
Else
'/debug:/ MsgBox "OK: " & strTag & "," & fl.Name
'// Logfileのopenエラーならパス //
Dim TextBuff As String
Open fl.Path & "\" & LogFile For Input As #1
If Err.Number = 0 Then
Do Until EOF(1)
Line Input #1, TextBuff
'1行処理
'/debug:/ allbuf = allbuf + TextBuff
'/----------------------------------------------------
'/ログデータ処理= タグ名シートの、各フィールドへ○付け
'/----------------------------------------------------
Call setLogDataByTagName(strTag, strCh2, fl.Name, TextBuff)
Loop
Close #1
Else
Err.Clear
End If
End If
Next fl
Set fso = Nothing
ActiveWorkbook.Worksheets(1).Activate
Dim strNewFileFullName
strNewFileFullName = newExcelBook() '// 生成シートを、別ファイルの日付付きで、保存
Call addHistory(strNewFileFullName) '// 履歴の追記
'// 集計結果をすぐ開く //
Dim iCode As Integer
iCode = MsgBox("★ 集計完了 ★" & vbCrLf & "集計結果excelを開きますか？" & vbCrLf & " → [ " & strNewFileFullName & " ]", vbYesNo + vbQuestion, "確認")
If iCode = vbYes Then
Workbooks.Open strNewFileFullName
ActiveWorkbook.Worksheets(1).Activate
End If
'------------------
End Sub
'-------------------------------------------------------------------------------
'// ファイル名の先頭2文字でマスター登録タグかどうか判定(ch2名またはblankを返却)
'-------------------------------------------------------------------------------
Function getCh2Name(strLogFileName)
Dim strCh, iCnt
getCh2Name = ""
strCh = Left(strLogFileName, 2)
'/ 初期globalで確認,なければNulを返す /
iCnt = 1
While iCnt <= 4
If strCh = TagCh2(iCnt) Then
getCh2Name = strCh
Exit Function
End If
iCnt = iCnt + 1
Wend
End Function
'------------------------------------------------------
'// ファイル名から、タグ名を(tag名またはblankを返却)
'------------------------------------------------------
Function getTagName(strLogFileName)
Dim strCh, iCnt
getTagName = ""
strCh = Left(strLogFileName, 2)
'/ 初期globalで確認,なければNulを返す /
iCnt = 1
While iCnt <= 4
If strCh = TagCh2(iCnt) Then
getTagName = TagName(iCnt)
Exit Function
End If
iCnt = iCnt + 1
Wend
End Function
'-------------------------------------------------------
'// ログデータ処理= タグ名シートの、各フィールドへ○付け
'-------------------------------------------------------
Sub setLogDataByTagName(strTag, strCh2, strFileNameSpec, TextBuff)
Dim strSheetName, strHostName, strDateTime, strFldNameALL, strStat, tblData, tagetRange, fooR, iNext, iFld, iR, flgNamed, cntNew, tmpStr
strSheetName = strTag '/ シート名特定
strHostName = strFileNameSpec '/ ホスト名
strDateTime = Left(TextBuff, 22) '/ ログ日時
strFldNameALL = Mid(TextBuff, 24) '/ フィールド文字列+(開始or終了)
strStat = Right(strFldNameALL, 3) '/ 終了判定文字
Dim GF
GF = 1
If strStat = "終了 " Then
Worksheets(strSheetName).Activate '/// MsgBox "/" & ActiveSheet.Name & "/"
flgNamed = 0
With range("A4").ListObject
For iR = 1 To .ListColumns(1).range.Count '/ excel Table-Listのデータカウンタ
If .ListColumns(3).range(iR) = strHostName Then
'/ 既存=ホスト名データが既にある場合 /
flgNamed = 1
.ListColumns(1).range(iR) = iR - 1
.ListColumns(2).range(iR) = strDateTime
.ListColumns(3).range(iR) = strHostName
.ListColumns(4).range(iR) = "=IF(4=COUNTIF($E" & iR + 3 & ":$H" & iR + 3 & "," & """" & "○" & """" & ")," & """" & "○" & """" & "," & """" & "×" & """" & ")"
For iFld = 1 To 4 '/フィールド文字列の判定/
If FldMaster(iFld) & "終了 " = strFldNameALL Then
.ListColumns(3 + 1 + iFld).range(iR) = "○"
End If
Next iFld
End If
Next iR
If flgNamed = 0 Then
'/ 新規=ホスト名データの行を追加
range("A4").ListObject.ListRows.Add
cntNew = range("A4").ListObject.ListRows.Count
With range("A4").ListObject.ListRows(cntNew)
.range(1) = cntNew - 1
.range(2) = strDateTime
.range(3) = strHostName
.range(4) = "=IF(4=COUNTIF($E" & cntNew + 3 & ":$H" & cntNew + 3 & "," & """" & "○" & """" & ")," & """" & "○" & """" & "," & """" & "×" & """" & ")"
For iFld = 1 To 4
'// 終端判定 //
If FldMaster(iFld) & "終了 " = strFldNameALL Then
.range(3 + 1 + iFld) = "○"
End If
Next iFld
End With
End If
End With
Else
'// 無視 //
End If
End Sub
'---------------------------------------------------
'// 生成したデータシートを、日付付きのbookとして保存
'---------------------------------------------------
Function newExcelBook()
On Error Resume Next
Dim iCnt, newBookFileName
For iCnt = 1 To 4
If iCnt = 1 Then
Workbooks.Add
End If
ThisWorkbook.Sheets(TagName(iCnt)).Move After:=ActiveWorkbook.Sheets(Sheets.Count)
Next iCnt
Application.DisplayAlerts = False
ActiveWorkbook.Sheets(1).Delete '余計なシート
Application.DisplayAlerts = True
ActiveWorkbook.Worksheets(1).Activate
'// deployFolder無ければ作成 //
If Dir(DeployFolder, vbDirectory) = "" Then
'/ 作成 /
Err.Clear
MkDir DeployFolder
If Err.Number <> 0 Then
'/folderが作成できない→致命的issue/
MsgBox (" ◆ 結果ファイルの出力用フォルダが存在しない、且つ、作成もできないので中断します。。 ◆ " & vbCrLf & "・・・取り敢えず、名前を付けて保存してください・・・")
Exit Function
Else
Err.Clear
End If
End If
newBookFileName = DeployFolder & "\" & "Trinity_ログ集計_" & Format(Now(), "yyyy-mm-dd_hh-mm-ss") & ".xlsx"
ActiveWorkbook.SaveAs newBookFileName
ActiveWorkbook.Close
newExcelBook = newBookFileName
End Function
'--------------------------------
'// 履歴の追記(HyperLinkも)
'--------------------------------
Sub addHistory(newBookFileName)
Dim cntNew
ActiveWorkbook.Worksheets(1).Activate
'// 履歴の追記 // C57 テーブル
range("C32").ListObject.ListRows.Add
cntNew = range("C32").ListObject.ListRows.Count
With range("C32").ListObject.ListRows(cntNew)
.range(1) = Format(Now(), "yyyy/mm/dd hh:mm:ss")
.range(2) = newBookFileName
.range(2).Hyperlinks.Add Anchor:=.range(2), Address:=.range(2).Value
End With
End Sub
'//EOF//