excel_vba_KBs

'-----------------------------

' トリニティログ収集

' 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

'// 初期処理 (マスターデータ設定値反映) //

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のコピー

'/debug:/ MsgBox TagName(iCnt) & "_template"

'/mod-1/ Worksheets(TagName(iCnt) & "_template").Copy After:=Worksheets("★Menu")

Worksheets("tag" & iCnt & "_template").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()

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

Do Until EOF(1)

Line Input #1, TextBuff

'1行処理

'/debug:/ allbuf = allbuf + TextBuff

'/----------------------------------------------------

'/ログデータ処理= タグ名シートの、各フィールドへ○付け

'/----------------------------------------------------

Call setLogDataByTagName(strTag, strCh2, fl.Name, TextBuff)

Loop

Close #1

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()

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

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//