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

「test.zip」をダウンロード

ある情報（テキスト）から項目を抽出する仕事があり、そのためのメモ

やりたいことは、大きく３つだけど、それを形にするのは手間だった。

■やりたいこと１：

　あるファイルから、あるファイルへ抽出結果を出したい

　VBAによる、ファイルの入出力

■やりたいこと２：

　抽出パターンはいくつかあるが、そのパターンに即した文字列抽出をしたい

　＝ある区間の文字列を抽出する処理　＋　結果をカンマ区切りにする。

■やりたいこと３：

　処理結果がどのようになったのか、できるだけ見たい。

　＝設計当初からトレース機能の充実

ソースサンプル

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)
        ‘ファイルから１行読み込む
        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

■やりたいこと１：

　これは、VBAのサンプルを参考に、Open ～　Close　までの処理をアレンジして肉付け。

　例外処理は、JavaやC#っぽく　Try Cactch finallyに似た感じにした。

■やりたいこと２：

　今回は、例として２つ設定

　・１行のうち、先頭～8バイトを抜く。

　・パラメータ（この場合"CODE1="）が設定されている場合、パラメータから8バイト分を抜く

　これらを、カンマ区切りの情報として格納するように設定。

■やりたいこと３：

　せっかくのEXＣＥＬなので、このマクロを組み込むセルの１行目～３行目を処理の

　トレース結果を表　示する領域とした。

　表示レベルは、インプット、抽出結果、抽出失敗　もっと細かくしてもいいけどとりあえず。