So-net Blogのエキスポートファイルから、データを引き出すExcelマクロを作った。

2008年の振り返りとして、このBlogのデータ分析をしようとしています。
Excelからエキスポートしたファイルからデータを抽出するマクロを作成しました。

・・・マクロは面倒だけど、学習のために作ろうか。。。なんて思いながら作ったところ、出来上がって使ったら作業速度が段違い。
認識を改めよう。自分。

環境：
Excel 2007
前提：
・シートにコマンドボタン"ボタン2"が追加されている
・Windows Scripting Runtimeが参照設定で追加されている
・エキスポートファイル形式：MT(MovableType)形式
・エキスポートファイルの文字コード："Shift-JIS"
・エキスポートしたファイルは複数選択可

Option Explicit

'共通変数宣言
Dim intCurrentCol As Integer    ' 現在データ入力中の行
Const CNT_INITIAL_ROW = 2       ' データ入力を開始する行

''
' 概要：ファイルを開くダイアログを表示し、Blogデータ解析を開始する
'
Sub ボタン2_Click()

    Dim selectFile As Variant
    Dim i As Integer
    
    intCurrentCol = CNT_INITIAL_ROW
    i = CNT_INITIAL_ROW
    
    
    'Application.FileDialog
    'msoFileDialogFilePicker：ファイル
    'msofiledialogfolderpicker :フォルダ
    With Application.FileDialog(msoFileDialogFilePicker)
    
        'ダイアログタイトル名
        .Title = "ファイル選択"
    
        '開いた時に表示されるフォルダ
        .InitialFileName = ThisWorkbook.Path
    
        '複数ファイル選択の可否 True：可能、False：不可
        .AllowMultiSelect = True
    
        'ファイルの種類
        .Filters.Add "ブログログ", "*.log"
        .Filters.Add "すべてのファイル", "*.*"
    
        '選択された場合
        If .Show = -1 Then
    
            '選択されたアイテムでループ
            For Each selectFile In .SelectedItems
                
                'Blogデータ分析実行
                Call showBlogData(CStr(selectFile))
            Next
        End If
    End With
    

End Sub

''
' 概要：So-net blogのエキスポートされたデータから、TITLE、CATEGORY、DATEを抜きだしセルに保存する。
' 引数：ファイルパス
Private Sub showBlogData(strFilePath As String)
    Dim FSOBlogData As New FileSystemObject ' FileSystemObject
    Dim TSBlogData As TextStream            ' TextStream
    Dim strCurrentLine As String            ' 一行作業用String
    
    'インスタンス生成
    Set FSOBlogData = CreateObject("Scripting.FileSystemObject")
    Set TSBlogData = FSOBlogData.opentextfile(strFilePath, ForReading)
    
    Do Until TSBlogData.AtEndOfStream
        ' 改行までをレコードとして読み込む
        strCurrentLine = TSBlogData.ReadLine
        
        ' 文字列にTITLEが含まれていたら1列目に格納する
        If InStr(strCurrentLine, "TITLE: ") = 1 Then
            Cells(intCurrentCol, 1).Value = Right(strCurrentLine, Len(strCurrentLine) - Len("TITLE: "))
        
        ' 文字列にCATEGORYが含まれていたら2列目に格納する
        ElseIf InStr(strCurrentLine, "CATEGORY: ") = 1 Then
            Cells(intCurrentCol, 2).Value = Right(strCurrentLine, Len(strCurrentLine) - Len("CATEGORY: "))
        
        ' 文字列にDATE: が含まれていたら3列目に格納する
        ElseIf InStr(strCurrentLine, "DATE: ") = 1 Then
            Cells(intCurrentCol, 3).Value = Right(strCurrentLine, Len(strCurrentLine) - Len("DATE: "))
            
            '次の行に移動する
            intCurrentCol = intCurrentCol + 1
        
        End If
    Loop
    
    'インスタンス破棄
    Set FSOBlogData = Nothing
    Set TSBlogData = Nothing
    
End Sub

---

参考：
「ファイル、フォルダ選択ダイアログ＠Excelマクロ・VBAのお勉強」
http://www.cocoaliz.com/excelVBA/index/13/

「Office TANAKA - FileSystemObjectの解説(目次)」
http://officetanaka.net/excel/vba/filesystemobject/index.htm

「[XL2002] UTF-8 形式のテキスト ファイルが文字化けする」
http://support.microsoft.com/kb/821863/ja

「VBA応用(テキストデータの読み込み)」
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110.html

「EXCELの日付データを文字列に変換したい - 教えて！goo」
http://oshiete1.goo.ne.jp/qa1621320.html

タグ：VBA Excel マクロ