【EXCEL VBA】テキストファイルのGREPを行い、結果を表示する

※EXCELブック内のGREPではなく、テキストファイルのGREPです。

テキストファイルのGREPを行い、結果を表示する

今回使用した環境

インターネット接続可能のオンラインの環境

64 ビット オペレーティング システム

Windows 10 22H2

Microsoft 365 Excel バージョン 2401

実現したいこと

以下のような「C:\csv」フォルダ配下に置かれているCSVファイル内をGREPして検索キーワードに合致するCSVの行をEXCELに一覧表示します。

サブフォルダの階層はどうなっているかわからないという想定ですので再帰処理とする必要があります。

VBAのソースコード

本来であれば検索キーワードなど、ユーザーによって変更が必要となる設定は、EXCEL上にテキストボックスなどを配置して入力できるようにするべきだとは思います。

ただ、画面デザインをするのが面倒だったので、ユーザーによって変更が必要となる設定は全てVBA上のConstにまとめてしまいました。必要に応じてユーザー入力をさせるようにしてください。

grepStartのメソッドを実行することでGREPが開始されます。GREPの結果はEXCELのカレントシートに表示されます。

Option Explicit

'検索フォルダパス
Const DIR_PATH As String = "C:\csv"
'検索対象ファイルの拡張子
Const EXTENSION As String = ".csv"
'検索対象ファイルの文字コード
Const ENCODING As String = "UTF-8"
'検索対象ファイルの改行コード
Const LINE_SEPARATOR = -1 'CRLF: -1, CR: 13, LF: 10
'検索キーワード
Const KEYWORD As String = "*消しゴム*"
'出力開始X座標
Const X_START As Integer = 1
'出力開始Y座標
Const Y_START As Integer = 2

'出力するEXCEL行番号
Dim excelRow As Integer

'GREPスタート
Sub grepStart()
    excelRow = Y_START
    searchDirAndFile (DIR_PATH)
End Sub

'検索フォルダ配下のフォルダ、ファイルを取得
Sub searchDirAndFile(dirPath As String)
    Dim fso As Object
    Dim objDir As Object
    Dim objFile As Object
    
    'ファイルシステムオブジェクト
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    '該当フォルダ配下のファイルを取得
    For Each objFile In fso.GetFolder(dirPath).Files
        '拡張子が一致するファイルの中をキーワード検索
        If LCase(Right(objFile, Len(EXTENSION))) = LCase(EXTENSION) Then
            searchKeyword (objFile)
        End If
    Next
    
    '該当フォルダ配下のフォルダを取得 (再帰処理)
    For Each objDir In fso.GetFolder(dirPath).SubFolders
        searchDirAndFile (objDir)
    Next

    Set fso = Nothing
End Sub

'ファイルの中をキーワード検索
Sub searchKeyword(filePath As String)
    Dim ad As Object
    Dim line As String
    Dim fileRow As Integer
    
    'ActiveXデータオブジェクト
    Set ad = CreateObject("ADODB.Stream")
    ad.Charset = ENCODING
    ad.LineSeparator = LINE_SEPARATOR
    ad.Open
    ad.LoadFromFile (filePath)
    
    fileRow = 1
    Do Until ad.EOS
        
        '1行を読込
        line = ad.ReadText(-2)
        
        '検索キーワードに一致する場合
        If line Like KEYWORD Then
            'EXCEL出力
            Cells(excelRow, X_START) = filePath
            Cells(excelRow, X_START + 1) = fileRow
            Cells(excelRow, X_START + 2) = line
            excelRow = excelRow + 1
        End If
        fileRow = fileRow + 1
    Loop
    ad.Close
    
    Set ad = Nothing
End Sub

※エラー処理は考慮していません。

動作確認

実行するとGREPの結果が表示されました。

以上となります。

ここまでお読みいただきありがとうございました。

Excel

Posted by だゆう