【EXCEL VBA】テキストファイルからの文字列の抽出サンプル

ある情報（テキスト）から項目を抽出するExcel VBAマクロのサンプルコードと実装のメモです。

やりたいことは大きく3つあり、それぞれの実装方法とトレース機能を盛り込んでいます。

■やりたいこと1：ファイルの入出力
あるテキストファイルからデータを読み込み、処理結果を別のファイルへ出力します。

■やりたいこと2：文字列の抽出
複数ある抽出パターン（先頭からの切り出し、特定キーワードに続く文字列の切り出しなど）に即して文字列を抽出します。

■やりたいこと3：トレース機能の充実
処理結果や進行状況がExcelシート上で視覚的に確認できるようにします。

サンプルコード

Option Explicit

Dim TraceLogCount As Integer

Private Sub CommandButton1_Click()
    Call StartExtract(TextBox1.Text, TextBox2.Text)
End Sub

Private Sub StartExtract(ByVal ReadFileName As String, ByVal WriteFileName As String)
On Error GoTo EXCEPTION

    Dim ReadFileNo As Integer
    Dim WriteFileNo As Integer
    Dim buf As String
    Dim ret As String
    
    'ファイル番号の取得
    ReadFileNo = FreeFile()
    'ファイルを読込モードで開く
    Open ReadFileName For Input As #ReadFileNo
    
    'ファイル番号の取得
    WriteFileNo = FreeFile()
    'ファイルを書込モードで開く
    Open WriteFileName For Output As #WriteFileNo
    
    Call TraceLogStart 'トレースログ開始
    '読取ファイルがEOFになるまでループ
    Do Until EOF(ReadFileNo)
        'ファイルから1行読み込む
        Line Input #ReadFileNo, buf
        '抽出できた場合のみ出力
        ret = ExtractString(buf)
        If Not (ret = "") Then
            Print #WriteFileNo, ret
        End If
        Call NextTrace
    Loop
    
  GoTo FINALLY

EXCEPTION:
  Call MsgBox(Err.Number & Err.Source & Err.Description)

FINALLY:
  Close #WriteFileNo
  Close #ReadFileNo

End Sub

'文字列抽出
Function ExtractString(ByRef buf As String) As String
On Error GoTo EXCEPTION
    Dim ret As String
    Dim tmp As String
    
    Call TraceLog(buf, 1)
    tmp = ExtractStringType1(buf)
    If tmp = "" Then
        GoTo FINALLY
    End If
    ret = tmp & ","
    
    tmp = ExtractStringType2(buf)
    If tmp = "" Then
        GoTo FINALLY
    End If
    ret = ret & tmp
    
    Call TraceLog(ret, 2)
    ExtractString = ret
    Exit Function
EXCEPTION:
    Call Err.Raise(Err.Number, "[ExtractString]" & Err.Source, Err.Description)
    
FINALLY:
    Call TraceLog(buf, 3)
    ExtractString = ""
End Function

'文字列抽出(先頭から8文字）
Function ExtractStringType1(ByRef buf As String) As String
On Error GoTo EXCEPTION
    ExtractStringType1 = Mid(buf, 1, 8)
    Exit Function
EXCEPTION:
    Call Err.Raise(Err.Number, "[ExtractStringType1]" & Err.Source, Err.Description)
End Function

'文字列抽出（"CODE1="の次から8文字）
Function ExtractStringType2(ByRef buf As String) As String
On Error GoTo EXCEPTION
    Dim pos As Integer
    Const SearchChar As String = "CODE1="
    
    pos = InStr(1, buf, SearchChar, vbTextCompare)
    ExtractStringType2 = Mid(buf, pos + Len(SearchChar), 8)
    
    Exit Function
EXCEPTION:
    Call Err.Raise(Err.Number, "[ExtractStringType2]" & Err.Source, Err.Description)
End Function

Sub TraceLogStart()
    'ログ初期化
    Me.Cells.Clear
    '文字列型に設定
    Me.Cells.NumberFormatLocal = "@"
    'トレースログヘッダ生成
    Me.Cells(1, 1) = "インプット"
    Me.Cells(1, 2) = "抽出結果"
    Me.Cells(1, 3) = "抽出失敗"
    
    'カウンタ初期化
    TraceLogCount = 2
End Sub

Sub TraceLog(ByVal buf As String, logtype As Integer)
    Cells(TraceLogCount, logtype) = buf
End Sub

Sub NextTrace()
    TraceLogCount = TraceLogCount + 1
End Sub

■補足と解説：

1. ファイル入出力と例外処理
VBAの標準的な Open ～ Close までの処理を整理し、他の言語（JavaやC#）の try-finally 構文に似た構造でエラーハンドリングを行っています。

2. 抽出パターンの実装
サンプルでは以下の2種類を実装しています。
・1行のうち先頭から8文字を抽出
・「CODE1=」という文字列を検索し、その次から8文字を抽出
それらを組み合わせてカンマ区切りで結合します。

3. トレース機能
Excelシートの1行目から3行目をトレース結果の表示エリアとして利用し、インプット内容や抽出結果、抽出失敗のステータスを確認できるようにしています。