Раскрашиваем NLog

Добавлю к предыдущему посту. Сегодня я написал первый в своей жизни VB скрипт:) Не без помощи конечно(спасибо мемберам с cyberforum). Для кого-то код будет ламерским, но он решает свою задачу. Стандартно NLog выводит информацию в файл в формате:

2012-08-31 12:08:06.6573|DEBUG|EVC.prog|Evconfig object was created. Start load configuration
2012-08-31 12:08:06.6846|DEBUG|EVC.Class1|Some additional information

Однако искать предупреждения или ошибки в куче такого текста, очень уныло. Вот я и решил немного подсластить пилюлю и раскрасить его. А делаю это так. Выводим в файл с расширением .log, ставим в свойствах файла Open with Excel. Теперь в самом Excel нужно добавить пару макросов. Как их добавлять можно легко найти на просторах интернета, отмечу лишь что лучше их сохранять в personal workbook. Тогда они будут доступны всегда, а не для определенного документа. Варианта открытия может быть 2. Первый, вы уже открыли Excel и теперь хотите импортировать в него лог. Тогда текст VB скрипта для макроса будет таким:

Sub LogView()
Dim OpenDialog, i, d
OpenDialog = Application.GetOpenFilename("Log Files (*.log),*.log,All Files (*.*),*.*", , "Выберите лог файл")
If OpenDialog = "False" Then Exit Sub
' Импортируем указаный файл, разделение по столбцам по символу |
Workbooks.OpenText Filename:=OpenDialog, Origin:=xlWindows, _
    StartRow:=1, _
    DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, _
    Tab:=False, _
    Semicolon:=False, _
    Comma:=False, _
    Space:=False, _
    Other:=True, OtherChar:="|"
' Пробегаемся по всем строчкам и раскрашиваем в зависимости от содержания
Dim cl As New Collection
 cl.Add RGB(245, 245, 220), "INFO"
 cl.Add RGB(224, 255, 255), "DEBUG"
 cl.Add RGB(255, 127, 80), "WARN"
 cl.Add RGB(255, 69, 0), "ERROR"
 cl.Add RGB(255, 0, 0), "FATAL"
 On Error Resume Next
For Each i In Columns("B").SpecialCells(xlCellTypeConstants)
    i.EntireRow.Interior.Color = cl(i.Value)
Next
Err.Clear
On Error GoTo 0
' Еще раз разделим первый столбец. Отдельно дата, отдельно время.
 Columns("B").Insert    
    Columns("A:A").Select
    Application.DisplayAlerts = False
    Selection.TextToColumns Destination:=Range("A:B"), _
        DataType:=xlFixedWidth, _
        OtherChar:="|", _
        FieldInfo:=Array(Array(0, 5), Array(10, 1)), _
        TrailingMinusNumbers:=True
    Application.DisplayAlerts = True
' Ширина столбцов на любителя
    Columns("A:A").ColumnWidth = 11
    Columns("B:B").ColumnWidth = 15
    Columns("C:C").ColumnWidth = 15
    Columns("D:D").ColumnWidth = 30
    Columns("E:E").ColumnWidth = 100
' Тут сделаем выравнивание и установим wrap text для последнего информативного столбца
    With Columns("E")
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Columns("B")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1").Select
End Sub

Для простоты добавил русских комментариев. Теперь другой вариант, когда вы открыли лог, запустился Excel, но все в одном столбце:

Sub ConvertToLog()
Dim i,d
Columns("A:A").Select
Application.DisplayAlerts = False
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, _
 OtherChar:="|", _
 FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _
    TrailingMinusNumbers:=True
Application.DisplayAlerts = True
Dim cl As New Collection
 cl.Add RGB(245, 245, 220), "INFO"
 cl.Add RGB(224, 255, 255), "DEBUG"
 cl.Add RGB(255, 127, 80), "WARN"
 cl.Add RGB(255, 69, 0), "ERROR"
 cl.Add RGB(255, 0, 0), "FATAL"
 On Error Resume Next
For Each i In Columns("B").SpecialCells(xlCellTypeConstants)
    i.EntireRow.Interior.Color = cl(i.Value)
Next
Err.Clear
On Error GoTo 0
    Columns("B").Insert 
    
    Columns("A:A").Select
    Application.DisplayAlerts = False
    Selection.TextToColumns Destination:=Range("A:B"), _
        DataType:=xlFixedWidth, _
        OtherChar:="|", _
        FieldInfo:=Array(Array(0, 5), Array(10, 1)), _
        TrailingMinusNumbers:=True
    Application.DisplayAlerts = True
' Set width
    Columns("A:A").ColumnWidth = 11
    Columns("B:B").ColumnWidth = 15
    Columns("C:C").ColumnWidth = 15
    Columns("D:D").ColumnWidth = 30
    Columns("E:E").ColumnWidth = 100
' Set text wrap
    With Columns("E")
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Columns("B")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1").Select
End Sub

Дополнительно я назначил хоткеи CTRL+SHIFT+L и CTRL+SHIFT+K и добавил их в Quick Access Toolbar.

Над цветами еще конечно можно поработать, но остальное очевидно. Profit!