Option Explicit
Public currentSheet As Object, currentRow As Long
Sub ParseLogFile()
'=============================================
'ログファイルを解析してExcelシートを作成するマクロ
'=============================================
Dim fs As Object, ts As Object
Dim excelApp As Object, newWorkbook As Object
Dim currentSheet As Object, currentRow As Long
Dim logFilePath As String, line As String
Dim sectionName As String, currentItem As String
Dim itemCounter As Long, lineParts() As String
'ログファイルパスの取得(B1セル指定)
logFilePath = ThisWorkbook.Sheets(1).Range("B1").Value
'ADODB.Streamオブジェクトの作成(UTF-8対応)
Dim stream As Object
Set stream = CreateObject("ADODB.Stream")
stream.Charset = "utf-8"
stream.Open
stream.LoadFromFile logFilePath
'新しいExcelアプリケーションの起動
Set excelApp = CreateObject("Excel.Application")
Set newWorkbook = excelApp.Workbooks.Add
excelApp.Visible = True
'初期設定
Set currentSheet = Nothing
itemCounter = 0
'ログファイルの行処理
Do Until stream.EOS
line = Trim(stream.ReadText(-2))
'セクションの判定(==== セクション名 ====)
If Left(line, 4) = "====" And Right(line, 4) = "====" Then
sectionName = Replace(Replace(line, "====", ""), " ", "")
CreateNewSheet newWorkbook, sectionName
currentRow = 1
End If
'小項目の判定(== 項目名)
If Left(line, 3) = "== " Then
itemCounter = 0
currentItem = Trim(Replace(line, "==", ""))
If currentRow > 2 Then currentRow = currentRow + 1
'小項目ヘッダーの作成
With currentSheet
.Range("A" & currentRow & ":B" & currentRow).Interior.Color = RGB(0, 0, 255)
.Range("A" & currentRow) = "No."
.Range("B" & currentRow) = currentItem
.Range("A" & currentRow & ":B" & currentRow).Font.Color = RGB(255, 255, 255)
currentRow = currentRow + 1
End With
End If
'通常行の処理
If Left(line, 2) <> "==" And Len(line) > 0 Then
itemCounter = itemCounter + 1
With currentSheet
.Range("A" & currentRow) = itemCounter
.Range("B" & currentRow) = line
.Range("A" & currentRow & ":B" & currentRow).Borders.LineStyle = 1
currentRow = currentRow + 1
End With
End If
Loop
stream.Close
Set stream = Nothing
End Sub
Sub CreateNewSheet(wb As Object, sheetName As String)
'=============================================
'新しいシートを作成するサブルーチン
'=============================================
On Error Resume Next
wb.Sheets(sheetName).Delete
On Error GoTo 0
Dim newSheet As Object
Set newSheet = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
newSheet.Name = sheetName
Set currentSheet = newSheet
End Sub
Register as a new user and use Qiita more conveniently
- You get articles that match your needs
- You can efficiently read back useful information
- You can use dark theme