ExcelVBA 目次 - ray88’s diary
■Processモジュール
Option Explicit Sub Main() Dim strOutputFolderPath As String 'アウトプットフォルダのバス Dim strWriteFilePath As String 'ログファイル編集結果書き込み用エクセルファイルパス Dim strReadFilePath As String '読み込み用ログファイルのバス Dim strFileName As String '読込用ログファイルのファイル名 Dim wb As Workbook '書き込み用エクセルブックを格納 Dim strBlankMsg As String 'ログファイルまたは出力先フォルダの欄が空欄の場合のエラーメッセージ '読み取り用ログファイルパスと結果出力先フォルダパスの取得 With Sheets("Main") strReadFilePath = Range(strLogFilePathCell) strOutputFolderPath = Range(strOutputFolderPathCell) End With '空欄チェック strBlankMsg = fncCheckBlankCell(strReadFilePath, strOutputFolderPath) If strBlankMsg <> "" Then MsgBox strBlankMsg Exit Sub End If '各バスの存在確認 If fnclsExistsFile(strReadFilePath) = False Then MsgBox "指定されたログファイルが存在しません" Exit Sub End If If fnclsExistsDir(strOutputFolderPath) = False Then MsgBox "指定された結果ファイル格納先フォルダが存在しません" Exit Sub End If '書込み用テキストファイルを生成 strFileName = Replace(Dir(strReadFilePath), ".log", "") strWriteFilePath = strOutputFolderPath & "\" & Format(Now, "yyyyMMddhhmm") & "_【編集後ログ】" & strFileName & ".xlsx" Set wb = Workbooks.Add wb.SaveAs strWriteFilePath Call UiPatheditTextFile(strReadFilePath, wb) Set wb = Nothing '完了メッセージを表示 MsgBox "作業完了しました。" End Sub Sub UiPatheditTextFile(targetPath As String, wb As Workbook) '------------------------------------------------- '機能：UTF8形式のUiPathのLogファイルを編集しエクセルの表に書き出す '引数: UTF-8形式の読み込み用テキストファイルパス '引数2：エクセルワークブック '------------------------------------------------- Dim folderPath As String '書込用CSVファイルのフォルダパス Dim fileName As String '書込用 CSVファイルのファイル名 Dim FSO As Object 'FileSystemObjectインスタンス化用の変数 Dim editText As Object 'TextStreamオブジェクト格納用 Dim intIndex As Long '行番号取得用 Dim temp As String '読取用ファイルのテキスト一時格納用 Dim dataArray As Variant '読込データ各様用配列 Dim editData As Variant '配列より取り出したデータ格納用 Dim editLineData As Variant 'データ書き込み時に各データを結合して格納 Dim maxNum As Integer '配列最大?格納用 Dim i As Integer '配列カウント用変数 Dim j As Long 'エクセル貼付用カウント変数 Dim intStartPoint As Integer '文字列中のセミコロンの位置 'FileSystemObjectをインスタンス化 Set FSO = CreateObject("Scripting.FilesystemObject") '見出し項目名を記入 Call writeHeader(wb, "Sheet1") 'エクセル貼付用カウンタ変数初期化 j = 2 'インデックス番号を初期化。 このプログラムではインデックスを使用してないが '見出し行を飛ばして処理したり、最終行数を取得したりする際に使用する intIndex = 0 'ADODB.Streamを遅延バインディング With CreateObject("ADODB.Stream") '文字コードを指定 (文字化け防止のため) .Charset = "UTF-8" .Open .LoadFromFile targetPath 'ファイルの最後まで繰り返し Do Until .EOS Call 変数初期化 '各フィールドの値を1行分参照して変数 「temp」 に格納 'ReadTeat の定数 「-2」 は 「adReadLine」 でストリームからの次の行を読み取り ' 「-1」 は 「adReadAll」 で現在位置からEOSマーカー方向にすべてのバイトをストリームから読みとる temp = .ReadText(-2) '★区切り文字を変換 temp = Replace(temp, Chr(34) & "," & Chr(34), Chr(34) & "^" & Chr(34)) temp = Replace(temp, "," & Chr(34), "^" & Chr(34)) '「temp」 に格納した1行分の値をカンマで区切って配列 「dataArray」 に格納 'dataArray = Split(temp,",") '★区切り文字を「^」にしてみる dataArray = Split(temp, "^") '配列 「dataArray」の最大値を取得 maxNum = UBound(dataArray) '0列目～Maxの列までくりかえし For i = 0 To maxNum strTemp = "" strItemName = "" Debug.Print dataArray(i) Debug.Print "配列番号:" & i; "値:" & dataArray(i) On Error Resume Next '配列番号0の場合 「Log: 2020-07-20 15:49:51:KSEC-2004PC0351」 形式の文字列の '6文字目以降19文字目までを取得 If i = 0 Then strDate = "," & Mid(dataArray(i), 1, 13) strMessage = Mid(dataArray(i), 31) strMessage = Replace(strMessage, Chr(34), "") strMessage = Replace(strMessage, "\r\n", vbCrLf) Debug.Print strDate Debug.Print strMessage '配列番号1~11までは項目名固定 ElseIf i > 0 And i <= 11 Then intStartPoint = InStr(dataArray(i), ":") strTemp = Mid(dataArray(i), intStartPoint + 1) '★ダブルクォーテーション取る strTemp = Replace(strTemp, Chr(34), "") Select Case i Case 1 strLevel = strTemp Debug.Print "level: " & strLevel Case 2 strLogType = strTemp Debug.Print "strlogtype:" & strLogType Case 3 strTimeStamp = "" & strTemp Debug.Print "strTimeStamp:" & strTimeStamp Case 4 strFingerPrint = strTemp Debug.Print "strFingerPrint:" & strFingerPrint; "" Case 5 strWinId = strTemp Debug.Print "strWinId:" & strWinId Case 6 strMachineName = strTemp Debug.Print "strMachineName:" & strMachineName Case 7 strProcessName = strTemp Debug.Print "strProcessName:" & strProcessName Case 8 strProcessVersion = strTemp Debug.Print "strProcessVersion:" & strProcessVersion Case 9 strJobId = strTemp Debug.Print "strJobId:" & strJobId Case 10 strRobotName = strTemp Debug.Print "strRobotName:" & strRobotName Case 11 strMachineId = strTemp Debug.Print "strMachineId:" & strMachineId End Select '配列番号12~14は可変 (12までの時と14までの時があり、それにより項目名が相違する) Else intStartPoint = InStr(dataArray(i), "") strItemName = Left(dataArray(1), intStartPoint - 1) strItemName = Replace(strItemName, Chr(34), "") strTemp = Mid(dataArray(i), intStartPoint + 1) '★「}」 とダブルクォーテーション取る strTemp = Replace(strTemp, "}", "") strTemp = Replace(strTemp, Chr(34), "") Debug.Print "項目名" & strItemName: Select Case strItemName Case "fileName" strFileName = strTemp Debug.Print strFileName Case "totalExecutionTimeInSeconds" strTotalExecutionTimeInSeconds = strTemp Debug.Print strTotalExecutionTimeInSeconds Case "totalExecutionTime" strTotalExecutionTime = strTemp Debug.Print strTotalExecutionTime End Select End If On Error GoTo 0 Next i '各項目の値を記入 Call writeItemValue(wb, "Sheet1", j) 'エクセル用カウンタ1足す j = j + 1 intIndex = intIndex + 1 Loop '読込用ファイルをクローズ .Close End With 'エクセルワークブックの各列 行をオートフィットして上書き保存し閉じる Application.DisplayAlerts = False Cells.EntireColumn.AutoFit Cells.EntireRow.AutoFit wb.Save wb.Close Application.DisplayAlerts = True '終了処理 Set FSO = Nothing End Sub Sub writeHeader(wb As Workbook, SheetName As String) '------------------------------------------------- '機能: 書込み用ファイルにヘッダー項目を書き込んで保存 '引数1: 書き込み用ファイルブック '引数2: 書き込み先シート名 '------------------------------------------------- '見出し項目名を記入 Application.ScreenUpdating = False With wb.Sheets(SheetName) .Cells(1, intDateTimeCol) = "時間" .Cells(1, intMessageCol) = "message" .Cells(1, intLevelCol) = "level" .Cells(1, intLogTypeCol) = "logType" .Cells(1, intTimeStampCol) = "timestamp" .Cells(1, intFingerprintCol) = "fingerprint" .Cells(1, intWinIdCol) = "windowsIdentity" .Cells(1, intMachineNameCol) = "machineName" .Cells(1, intProcessNameCol) = "processName" .Cells(1, intProcessVersionCol) = "processVersion" .Cells(1, intJobIdCol) = "jobId" .Cells(1, intRobotNameCol) = "robotName" .Cells(1, intMachineIdCol) = "machineId" .Cells(intTotalExecutionTimeInSecondsCol) = "Total ExecutionTimeInSeconds" .Cells(1, intTotalExecutionTimeCol) = "Total ExecutionTime" .Cells(1, intFileNameCol) = "fileName" End With Application.ScreenUpdating = True End Sub Sub 変数初期化() '------------------------------------------------- '各項目の値格納用の変数を初期化 '------------------------------------------------- strDate = "" strMessage = "" strLevel = "" strLogType = "" strTimeStamp = "" strFingerPrint = "" strWinId = "" strMachineName = "" strProcessName = "" strProcessVersion = "" strJobId = "" strRobotName = "" strMachineId = "" strTotalExecutionTimeInSeconds = "" strTotalExecutionTime = "" strFileName = "" End Sub Sub writeItemValue(wb As Workbook, SheetName As String, j As Long) '------------------------------------------------- '機能: 書込み用ファイルに各項目の値を書き出し' '引数1: 書き込み用ファイルブック '引数2: 書き込み先シート名 '引数3: エクセル行用カウンタ変数 '------------------------------------------------- Application.ScreenUpdating = False With wb.Sheets(SheetName) .Cells(j, intDateTimeCol) = strDate .Cells(j, intMessageCol) = strMessage .Cells(j, intLevelCol) = strLevel .Cells(j, intLogTypeCol) = strLogType .Cells(j, intTimeStampCol) = strTimeStamp .Cells(j, intFingerprintCol) = strFingerPrint .Cells(j, intWinIdCol) = strWinId .Cells(j, intMachineNameCol) = strMachineName .Cells(j, intProcessNameCol) = strProcessName .Cells(j, intProcessVersionCol) = strProcessVersion .Cells(j, intJobIdCol) = strJobId .Cells(j, intRobotNameCol) = strRobotName .Cells(j, intMachineIdCol) = strMachineId .Cells(j, intTotalExecutionTimeInSecondsCol) = strTotalExecutionTimeInSeconds .Cells(j, intTotalExecutionTimeCol) = strTotalExecutionTime .Cells(j, intFileNameCol) = strFileName End With Application.ScreenUpdating = True End Sub
