LoginSignup
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

@t_nakada0523

【Excel VBA】フォルダ内ファイルをGrep検索するツールを作ってみた

Posted at

はじめに

業務でログファイルやソースコードから特定の文字列を探したいとき、ありませんか？

「あのエラーメッセージ、どのファイルに出てたっけ...」
「このSQL文、どこで使われてる？」

そんなときに便利な Excel VBA製Grepツール を作成しました。
検索結果はExcelシートに出力されるので、フィルタリングや共有も簡単です。

完成イメージ

検索結果イメージ

検索を実行すると、以下のような結果シートが自動生成されます：

No. ファイルパス 行番号 内容
1 C:\Projects\main.py 45 # TODO: implement error handling
2 C:\Projects\utils.py 123 # TODO fix this later
3 C:\Projects\api\routes.js 78 // TODO: add authentication

機能一覧

機能 説明
📂 フォルダ検索 指定フォルダ内のファイルを検索
🔄 サブフォルダ対応 サブフォルダを含めた再帰検索
📝 拡張子フィルタ txt, csv, sql, py など対象を絞り込み
🔤 大文字小文字 区別する/しないを選択可能
🔍 正規表現 VBScript.RegExpによるパターン検索
🔗 ハイパーリンク ファイルパスをクリックで直接開ける
🎨 オートフィルター 結果の絞り込みが簡単

環境

  • Windows 10/11
  • Microsoft Excel 2016以降（Microsoft 365でも動作確認済み）

ソースコード

Grepツール本体（GrepTool.bas）

Option Explicit

Private Type SearchResult
    FilePath As String
    LineNumber As Long
    LineContent As String
End Type

Private Results() As SearchResult
Private ResultCount As Long
Private TotalFiles As Long
Private TotalMatches As Long

'=============================================================================
' メイン処理: Grepツール実行
'=============================================================================
Public Sub RunGrepTool()
    Dim folderPath As String, searchText As String, fileExtensions As String
    Dim includeSubfolders As Boolean, caseSensitive As Boolean, useRegex As Boolean
    
    ' 入力フォームを表示
    If Not ShowInputForm(folderPath, searchText, fileExtensions, _
                         includeSubfolders, caseSensitive, useRegex) Then
        Exit Sub
    End If
    
    ' 初期化
    ResultCount = 0: TotalFiles = 0: TotalMatches = 0
    ReDim Results(0)
    
    ' 検索実行
    Application.StatusBar = "検索中..."
    Application.ScreenUpdating = False
    
    SearchInFolder folderPath, searchText, fileExtensions, _
                   includeSubfolders, caseSensitive, useRegex
    OutputResults searchText, folderPath, fileExtensions, caseSensitive, useRegex
    
    Application.StatusBar = False
    Application.ScreenUpdating = True
    
    MsgBox "検索完了!" & vbCrLf & _
           "検索ファイル数: " & TotalFiles & vbCrLf & _
           "ヒット件数: " & TotalMatches, vbInformation, "Grepツール"
End Sub

'=============================================================================
' 入力フォーム表示
'=============================================================================
Private Function ShowInputForm(ByRef folderPath As String, _
                               ByRef searchText As String, _
                               ByRef fileExtensions As String, _
                               ByRef includeSubfolders As Boolean, _
                               ByRef caseSensitive As Boolean, _
                               ByRef useRegex As Boolean) As Boolean
    
    ' フォルダ選択ダイアログ
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "検索対象フォルダを選択"
        .InitialFileName = ThisWorkbook.Path
        If .Show = -1 Then
            folderPath = .SelectedItems(1)
        Else
            ShowInputForm = False
            Exit Function
        End If
    End With
    
    ' 検索文字列入力
    searchText = InputBox("検索する文字列を入力:", "Grepツール", "")
    If searchText = "" Then
        ShowInputForm = False
        Exit Function
    End If
    
    ' 拡張子入力
    fileExtensions = InputBox("対象拡張子 (カンマ区切り):" & vbCrLf & _
                              "※空欄で全ファイル", _
                              "Grepツール", "txt,csv,sql,vbs,bas,cls,log,py,js,html")
    
    ' オプション選択
    includeSubfolders = (MsgBox("サブフォルダも検索?", vbYesNo + vbQuestion) = vbYes)
    caseSensitive = (MsgBox("大文字小文字を区別?", vbYesNo + vbQuestion) = vbYes)
    useRegex = (MsgBox("正規表現を使用?", vbYesNo + vbQuestion) = vbYes)
    
    ShowInputForm = True
End Function

'=============================================================================
' フォルダ内を再帰的に検索
'=============================================================================
Private Sub SearchInFolder(ByVal folderPath As String, _
                           ByVal searchText As String, _
                           ByVal fileExtensions As String, _
                           ByVal includeSubfolders As Boolean, _
                           ByVal caseSensitive As Boolean, _
                           ByVal useRegex As Boolean)
    
    Dim fso As Object, folder As Object, file As Object, subfolder As Object
    Dim extArray() As String, fileExt As String
    Dim i As Long, isTargetExt As Boolean
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(folderPath) Then Exit Sub
    Set folder = fso.GetFolder(folderPath)
    
    ' 拡張子配列を作成
    If fileExtensions <> "" Then
        extArray = Split(LCase(Replace(fileExtensions, " ", "")), ",")
    End If
    
    ' ファイルを検索
    For Each file In folder.Files
        isTargetExt = True
        If fileExtensions <> "" Then
            fileExt = LCase(fso.GetExtensionName(file.Path))
            isTargetExt = False
            For i = LBound(extArray) To UBound(extArray)
                If fileExt = extArray(i) Then
                    isTargetExt = True
                    Exit For
                End If
            Next i
        End If
        
        If isTargetExt Then
            SearchInFile file.Path, searchText, caseSensitive, useRegex
        End If
        DoEvents ' 応答性を維持
    Next file
    
    ' サブフォルダを再帰検索
    If includeSubfolders Then
        For Each subfolder In folder.SubFolders
            SearchInFolder subfolder.Path, searchText, fileExtensions, _
                          includeSubfolders, caseSensitive, useRegex
        Next subfolder
    End If
End Sub

'=============================================================================
' ファイル内を検索
'=============================================================================
Private Sub SearchInFile(ByVal filePath As String, _
                         ByVal searchText As String, _
                         ByVal caseSensitive As Boolean, _
                         ByVal useRegex As Boolean)
    
    Dim fso As Object, ts As Object
    Dim lineText As String, lineNumber As Long
    Dim isMatch As Boolean, regex As Object
    
    On Error GoTo ErrorHandler
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' バイナリファイルをスキップ
    If IsBinaryFile(filePath) Then Exit Sub
    
    TotalFiles = TotalFiles + 1
    Application.StatusBar = "検索中: " & filePath
    
    ' 正規表現オブジェクト準備
    If useRegex Then
        Set regex = CreateObject("VBScript.RegExp")
        regex.Global = True
        regex.IgnoreCase = Not caseSensitive
        regex.Pattern = searchText
    End If
    
    ' ファイルを行ごとに検索
    Set ts = fso.OpenTextFile(filePath, 1, False)
    lineNumber = 0
    
    Do While Not ts.AtEndOfStream
        lineNumber = lineNumber + 1
        lineText = ts.ReadLine
        
        ' マッチ判定
        isMatch = False
        If useRegex Then
            isMatch = regex.Test(lineText)
        Else
            If caseSensitive Then
                isMatch = (InStr(1, lineText, searchText, vbBinaryCompare) > 0)
            Else
                isMatch = (InStr(1, lineText, searchText, vbTextCompare) > 0)
            End If
        End If
        
        If isMatch Then AddResult filePath, lineNumber, lineText
    Loop
    
    ts.Close
    Exit Sub
    
ErrorHandler:
    On Error Resume Next
    If Not ts Is Nothing Then ts.Close
End Sub

'=============================================================================
' バイナリファイル判定
'=============================================================================
Private Function IsBinaryFile(ByVal filePath As String) As Boolean
    Dim fso As Object, fileExt As String, binaryExts As String
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    fileExt = LCase(fso.GetExtensionName(filePath))
    
    binaryExts = ",exe,dll,zip,rar,7z,gz,jpg,jpeg,png,gif,bmp," & _
                 "pdf,doc,docx,xls,xlsx,ppt,pptx,mp3,mp4,avi,db,mdb,"
    
    IsBinaryFile = (InStr(1, binaryExts, "," & fileExt & ",", vbTextCompare) > 0)
End Function

'=============================================================================
' 検索結果を追加
'=============================================================================
Private Sub AddResult(ByVal filePath As String, _
                      ByVal lineNumber As Long, _
                      ByVal lineContent As String)
    
    ResultCount = ResultCount + 1
    TotalMatches = TotalMatches + 1
    ReDim Preserve Results(ResultCount)
    
    Results(ResultCount).FilePath = filePath
    Results(ResultCount).LineNumber = lineNumber
    
    ' 長すぎる行は切り詰め
    If Len(lineContent) > 500 Then
        Results(ResultCount).LineContent = Left(lineContent, 500) & "..."
    Else
        Results(ResultCount).LineContent = lineContent
    End If
End Sub

'=============================================================================
' 検索結果を新規シートに出力
'=============================================================================
Private Sub OutputResults(ByVal searchText As String, _
                          ByVal folderPath As String, _
                          ByVal fileExtensions As String, _
                          ByVal caseSensitive As Boolean, _
                          ByVal useRegex As Boolean)
    
    Dim ws As Worksheet, i As Long, row As Long
    
    ' 新規シート作成
    Set ws = ThisWorkbook.Worksheets.Add
    ws.Name = "Grep_" & Format(Now, "yyyymmdd_hhnnss")
    
    ' ヘッダー情報
    ws.Cells(1, 1).Value = "Grep検索結果"
    ws.Cells(1, 1).Font.Bold = True
    ws.Cells(1, 1).Font.Size = 14
    
    ws.Cells(2, 1).Value = "検索文字列:"
    ws.Cells(2, 2).Value = searchText
    ws.Cells(3, 1).Value = "フォルダ:"
    ws.Cells(3, 2).Value = folderPath
    ws.Cells(4, 1).Value = "拡張子:"
    ws.Cells(4, 2).Value = IIf(fileExtensions = "", "(全)", fileExtensions)
    ws.Cells(5, 1).Value = "大文字小文字:"
    ws.Cells(5, 2).Value = IIf(caseSensitive, "区別", "無視")
    ws.Cells(6, 1).Value = "正規表現:"
    ws.Cells(6, 2).Value = IIf(useRegex, "使用", "不使用")
    ws.Cells(7, 1).Value = "検索日時:"
    ws.Cells(7, 2).Value = Format(Now, "yyyy/mm/dd hh:nn:ss")
    ws.Cells(8, 1).Value = "ファイル数:"
    ws.Cells(8, 2).Value = TotalFiles
    ws.Cells(9, 1).Value = "ヒット数:"
    ws.Cells(9, 2).Value = TotalMatches
    
    ' 結果テーブルヘッダー
    row = 11
    ws.Cells(row, 1).Value = "No."
    ws.Cells(row, 2).Value = "ファイルパス"
    ws.Cells(row, 3).Value = "行番号"
    ws.Cells(row, 4).Value = "内容"
    
    With ws.Range(ws.Cells(row, 1), ws.Cells(row, 4))
        .Font.Bold = True
        .Interior.Color = RGB(68, 114, 196)
        .Font.Color = RGB(255, 255, 255)
    End With
    
    ' 結果データ出力
    For i = 1 To ResultCount
        row = row + 1
        ws.Cells(row, 1).Value = i
        ws.Cells(row, 2).Value = Results(i).FilePath
        ws.Cells(row, 3).Value = Results(i).LineNumber
        ws.Cells(row, 4).Value = Results(i).LineContent
        
        ' 交互に背景色
        If i Mod 2 = 0 Then
            ws.Range(ws.Cells(row, 1), ws.Cells(row, 4)).Interior.Color = RGB(242, 242, 242)
        End If
        
        ' ハイパーリンク追加
        On Error Resume Next
        ws.Hyperlinks.Add Anchor:=ws.Cells(row, 2), _
                          Address:=Results(i).FilePath, _
                          TextToDisplay:=Results(i).FilePath
        On Error GoTo 0
    Next i
    
    ' 列幅調整
    ws.Columns(1).ColumnWidth = 6
    ws.Columns(2).ColumnWidth = 60
    ws.Columns(3).ColumnWidth = 10
    ws.Columns(4).ColumnWidth = 80
    
    ' フィルター設定
    If ResultCount > 0 Then
        ws.Range(ws.Cells(11, 1), ws.Cells(11 + ResultCount, 4)).AutoFilter
    End If
    
    ws.Activate
    ws.Cells(1, 1).Select
End Sub

コード解説

1. ユーザー定義型（Type）で検索結果を管理

Private Type SearchResult
    FilePath As String
    LineNumber As Long
    LineContent As String
End Type

検索結果を構造化して管理することで、後の出力処理が簡潔になります。

2. FileSystemObjectでファイル操作

Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderPath)

For Each file In folder.Files
    ' ファイル処理
Next file

Scripting.FileSystemObjectを使うことで、フォルダ・ファイル操作が直感的に記述できます。

3. 正規表現検索の実装

Set regex = CreateObject("VBScript.RegExp")
regex.Global = True
regex.IgnoreCase = Not caseSensitive
regex.Pattern = searchText

If regex.Test(lineText) Then
    ' マッチした場合の処理
End If

VBScript.RegExpオブジェクトを使用することで、正規表現による高度な検索が可能です。

4. バイナリファイルのスキップ

binaryExts = ",exe,dll,zip,rar,7z,gz,jpg,jpeg,png,gif,bmp," & _
             "pdf,doc,docx,xls,xlsx,ppt,pptx,mp3,mp4,avi,db,mdb,"

IsBinaryFile = (InStr(1, binaryExts, "," & fileExt & ",", vbTextCompare) > 0)

バイナリファイルを検索対象から除外することで、エラーを防ぎ処理速度を向上させています。

5. ハイパーリンクで結果を使いやすく

ws.Hyperlinks.Add Anchor:=ws.Cells(row, 2), _
                  Address:=Results(i).FilePath, _
                  TextToDisplay:=Results(i).FilePath

ファイルパスをクリックするだけで該当ファイルを開けるようにしています。

GrepToolファイル自動生成マクロ

毎回コードをコピペするのは面倒なので、説明書付きのGrepToolファイルを自動生成するマクロも作成しました。

CreateGrepToolExcel.bas

Option Explicit

'=============================================================================
' GrepTool.xlsm を自動生成
'=============================================================================
Public Sub CreateGrepToolExcel()
    Dim wb As Workbook
    Dim wsUsage As Worksheet
    Dim wsCode As Worksheet
    Dim wsSample As Worksheet
    Dim savePath As String
    
    Application.ScreenUpdating = False
    
    ' 新規ブック作成
    Set wb = Workbooks.Add
    
    ' シート作成
    Set wsUsage = wb.Sheets(1)
    wsUsage.Name = "使い方"
    
    Set wsCode = wb.Sheets.Add(After:=wsUsage)
    wsCode.Name = "VBAコード"
    
    Set wsSample = wb.Sheets.Add(After:=wsCode)
    wsSample.Name = "検索結果サンプル"
    
    ' 不要なシートを削除
    Application.DisplayAlerts = False
    Do While wb.Sheets.Count > 3
        wb.Sheets(wb.Sheets.Count).Delete
    Loop
    Application.DisplayAlerts = True
    
    ' 各シートの内容を作成
    CreateUsageSheet wsUsage
    CreateCodeSheet wsCode
    CreateSampleSheet wsSample
    
    ' 保存
    savePath = Application.GetSaveAsFilename( _
        InitialFileName:="GrepTool.xlsm", _
        FileFilter:="Excel マクロ有効ブック (*.xlsm),*.xlsm", _
        Title:="GrepToolを保存")
    
    If savePath <> "False" Then
        wb.SaveAs Filename:=savePath, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        MsgBox "GrepTool.xlsm を作成しました！", vbInformation
    End If
    
    wsUsage.Activate
    Application.ScreenUpdating = True
End Sub

'=============================================================================
' 使い方シートを作成
'=============================================================================
Private Sub CreateUsageSheet(ws As Worksheet)
    With ws
        .Cells(1, 1).Value = "📂 Excel VBA Grepツール"
        .Cells(1, 1).Font.Bold = True
        .Cells(1, 1).Font.Size = 20
        .Cells(1, 1).Font.Color = RGB(68, 114, 196)
        
        .Cells(3, 1).Value = "フォルダ内のファイルから文字列を検索し、結果をExcelシートに出力するツールです。"
        
        .Cells(5, 1).Value = "🔧 機能一覧"
        .Cells(5, 1).Font.Bold = True
        
        .Cells(6, 1).Value = "  • フォルダ検索 - 指定フォルダ内のファイルを検索"
        .Cells(7, 1).Value = "  • サブフォルダ対応 - 再帰的に検索"
        .Cells(8, 1).Value = "  • 拡張子フィルタ - 対象ファイルを絞り込み"
        .Cells(9, 1).Value = "  • 大文字小文字 - 区別する/しないを選択"
        .Cells(10, 1).Value = "  • 正規表現 - パターン検索に対応"
        .Cells(11, 1).Value = "  • ハイパーリンク - クリックでファイルを開く"
        
        .Cells(13, 1).Value = "📋 セットアップ手順"
        .Cells(13, 1).Font.Bold = True
        
        .Cells(14, 1).Value = "1. このファイルを .xlsm 形式で保存"
        .Cells(15, 1).Value = "2. Alt + F11 でVBEを開く"
        .Cells(16, 1).Value = "3. 「挿入」→「標準モジュール」を選択"
        .Cells(17, 1).Value = "4. 「VBAコード」シートのコードをコピペ"
        .Cells(18, 1).Value = "5. 保存して Alt + F8 で「RunGrepTool」を実行"
        
        .Columns("A").ColumnWidth = 70
    End With
End Sub

'=============================================================================
' VBAコードシートを作成
'=============================================================================
Private Sub CreateCodeSheet(ws As Worksheet)
    Dim codeLines As Variant, i As Long
    
    With ws
        .Cells(1, 1).Value = "以下のコードをVBEの標準モジュールにコピー＆ペーストしてください"
        .Cells(1, 1).Font.Bold = True
        .Cells(1, 1).Font.Color = RGB(255, 0, 0)
        
        ' VBAコードを配列で取得して出力
        codeLines = GetGrepToolCode()
        For i = LBound(codeLines) To UBound(codeLines)
            .Cells(i + 3, 1).Value = codeLines(i)
            .Cells(i + 3, 1).Font.Name = "Consolas"
            .Cells(i + 3, 1).Font.Size = 10
        Next i
        
        .Columns("A").ColumnWidth = 150
    End With
End Sub

'=============================================================================
' 検索結果サンプルシートを作成
'=============================================================================
Private Sub CreateSampleSheet(ws As Worksheet)
    With ws
        .Cells(1, 1).Value = "Grep検索結果（サンプル）"
        .Cells(1, 1).Font.Bold = True
        .Cells(1, 1).Font.Size = 14
        
        ' サマリー
        .Cells(2, 1).Value = "検索文字列:"
        .Cells(2, 2).Value = "TODO"
        .Cells(3, 1).Value = "フォルダ:"
        .Cells(3, 2).Value = "C:\Projects\MyApp"
        
        ' ヘッダー
        .Cells(11, 1).Value = "No."
        .Cells(11, 2).Value = "ファイルパス"
        .Cells(11, 3).Value = "行番号"
        .Cells(11, 4).Value = "内容"
        
        With .Range("A11:D11")
            .Font.Bold = True
            .Font.Color = RGB(255, 255, 255)
            .Interior.Color = RGB(68, 114, 196)
        End With
        
        ' サンプルデータ
        .Cells(12, 1).Value = 1
        .Cells(12, 2).Value = "C:\Projects\MyApp\main.py"
        .Cells(12, 3).Value = 45
        .Cells(12, 4).Value = "# TODO: implement error handling"
        
        .Columns("A").ColumnWidth = 6
        .Columns("B").ColumnWidth = 50
        .Columns("C").ColumnWidth = 10
        .Columns("D").ColumnWidth = 60
    End With
End Sub

'=============================================================================
' Grepツールのコードを配列で返す（省略版）
'=============================================================================
Private Function GetGrepToolCode() As Variant
    ' 実際にはGrepTool.basの全コードを配列で返す
    ' 紙面の都合上、省略
    GetGrepToolCode = Array("Option Explicit", "", "' ... (省略) ...")
End Function

使い方

インストール手順

  1. VBAモジュールをインポート

    • Excelを開き、Alt + F11 でVBEを起動
    • 「ファイル」→「ファイルのインポート」でダウンロードした .bas ファイルを選択

  2. マクロ有効ブックとして保存

    • 「ファイル」→「名前を付けて保存」
    • ファイルの種類を「Excel マクロ有効ブック (*.xlsm)」に変更

実行手順

  1. Alt + F8 でマクロ一覧を表示
  2. RunGrepTool を選択して実行
  3. ダイアログに従って操作
    • 検索フォルダを選択
    • 検索文字列を入力
    • 対象拡張子を指定（カンマ区切り）
    • オプションを選択

正規表現の例

パターン 説明 マッチ例
TODO 単純な文字列 TODO
TODO.*fix TODOとfixの間に任意の文字 TODO: please fix
\d{4}-\d{2}-\d{2} 日付形式 2025-01-09
^# 行頭が#で始まる # コメント
error|warning errorまたはwarning error, warning

活用例

1. TODOコメントの洗い出し

検索文字列: TODO
拡張子: py,js,ts,sql

2. エラーログの検索

検索文字列: ERROR
拡張子: log
正規表現: OFF

3. 特定の関数の使用箇所を調査

検索文字列: ExecuteSQL
拡張子: bas,cls,vbs

4. 日付パターンの検索（正規表現）

検索文字列: \d{4}/\d{2}/\d{2}
正規表現: ON

注意事項

  • 文字コード: UTF-8のファイルは正しく読めない場合があります（Shift-JIS推奨）
  • 大容量ファイル: 数MB以上のファイルは処理に時間がかかります
  • バイナリファイル: exe, jpg, xlsx等は自動的にスキップされます
  • ネットワークドライブ: 検索速度が遅くなる場合があります

カスタマイズのヒント

バイナリ判定の拡張子を追加

binaryExts = ",exe,dll,zip,...,your_ext,"

デフォルトの拡張子を変更

fileExtensions = InputBox("...", "Grepツール", "txt,csv,sql,vbs,bas,cls,log")
                                                 ↑ ここを変更

検索結果の最大件数を制限

Private Const MAX_RESULTS As Long = 10000

Private Sub AddResult(...)
    If ResultCount >= MAX_RESULTS Then Exit Sub
    ' ...
End Sub

まとめ

Excel VBAでGrepツールを作成しました。

メリット

  • Excelさえあれば動作（追加インストール不要）
  • 検索結果をExcelで管理・共有できる
  • フィルタリングや並び替えが簡単
  • ハイパーリンクでファイルに直接アクセス

デメリット

  • 大量ファイルの検索は遅い
  • UTF-8対応が不完全
  • 本格的なGrepツール（ripgrep等）には速度で劣る

とはいえ、Excelしか使えない環境や検索結果をExcelで管理したい場合には便利なツールです。

ぜひカスタマイズして使ってみてください！

参考

ソースコード

GitHubにソースコードを公開予定です。

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?