ExcelでLTSV読むよー

LTSVが最近熱いですね。ログファイルのフォーマットはこれで決まり、みたいな。

とはいえ、業務システムだといまだに人月計算とスーツとExcelの世界なので、上司に提出する場合とかそのあたりの親和性をなんとかしたいところです。

そんなわけでExcelでLTSVを読めるようにVBAを書いてみました。これでログを罫線で囲ったりセルに色をつけたりできます!嬉しいのか、それ。
 

 

Attribute VB_Name = "LtsvLoader"
'
' LtsvLoader.bas
'
' This program is licensed under the MIT License.
' Copyright 2013, aike (@aike1000)
'
Option Explicit

Dim gHash As Object
Dim gMaxColumn As Integer

Sub LoadLTSV()
    ' ファイル選択ダイアログ
    Dim vFileName As Variant
    vFileName = _
        Application.GetOpenFilename( _
            FileFilter:="LTSVファイル(*.ltsv),*.ltsv" _
            , FilterIndex:=1 _
            , Title:="LTSVファイルオープン" _
            , MultiSelect:=False _
            )
    If vFileName = False Then
        Exit Sub
    End If
    LoadLtsvFile vFileName
End Sub


Sub LoadLtsvFile(filename As Variant)
    Dim st As ADODB.Stream
    Dim RowNo As Integer
    Dim str() As String
    Dim fLine As String
    Dim key As String
    Dim val As String
    Dim i As Integer
    
    gMaxColumn = 0
    Set gHash = CreateObject("Scripting.Dictionary")

    On Error GoTo Err

    'ADODB.Stream生成
    Set st = New ADODB.Stream
    'Textモード
    st.Type = adTypeText
    '文字コード(Shift_JIS, Unicode, UTF-8など)
    st.Charset = "Shift_JIS"
    '改行コード(adLF:LF, adCRLF:CRLF, adCR:CR)
    st.LineSeparator = adCRLF
    'Streamのオープン
    st.Open
    'ファイル読み込み
    st.LoadFromFile (filename)
    
    Sheets(1).Cells.Clear
    RowNo = 2
    'ファイルの終りまでループ
    Do While Not (st.EOS)
        'tab区切りで配列に格納
        fLine = st.ReadText(adReadLine)
        str = Split(fLine, vbTab)
        For i = 0 To UBound(str)
            SplitKeyVal str(i), key, val
            Sheets(1).Cells(RowNo, GetColumnByKey(key)) = val
        Next
        RowNo = RowNo + 1
    Loop

    st.Close
    Set st = Nothing
    Set gHash = Nothing
    Exit Sub

Err:
    Set st = Nothing
    Set gHash = Nothing
    MsgBox (Err.Description)
End Sub

' キーで指定したカラム位置を返す。新規のキーの場合は末尾のカラムに追加
Private Function GetColumnByKey(ByVal key As String) As Integer
    If gHash(key) = Empty Then
        gMaxColumn = gMaxColumn + 1
        gHash(key) = gMaxColumn
        Sheets(1).Cells(1, gMaxColumn) = key
        GetColumnByKey = gMaxColumn
    Else
        GetColumnByKey = gHash(key)
    End If
End Function

' 最初に見つかった「:」でキーとバリューを分割する
Private Sub SplitKeyVal(ByVal s As String, ByRef key As String, ByRef val As String)
    Dim pos As Integer
    pos = InStr(s, ":")
    key = Mid(s, 1, pos - 1)
    val = Mid(s, pos + 1, Len(s))
End Sub

※Excel2000とかでも普通に動きます。環境によってはVBのツール→参照設定からMicrosoft ActiveX Data Objectsの追加が必要かもしれません。