ワードマクロ集

フォルダ内のファイル中の文字列を検索するマクロ

こんな方におすすめ

  • 特定の文字列を含むファイルをピックアップして、その一覧を取得したい!

概要

このマクロは、検索文字列を含むファイルの名前と情報をピックアップするマクロ(グレップ(grep)マクロ)です。

普段、文書系ファイル(ワードファイル、テキストファイル、リッチテキストファイル)を扱うことが多い方に役立つと思います。

例えば、ワードファイルの作成中に、

以前にも似たような文面を書いた/見かけたことがあるなどのファイルだっけ?

とふと思った場合に、現在作成中のワードファイル中の文字列を使用して、それを含むファイル(ワードファイル、テキストファイル、リッチテキストファイル)をすぐに検索することができます。

以下に、このマクロの概要をイラストで示します。

グレップマクロの概要
グレップマクロの概要
グレップマクロの概要

詳細説明

マクロの準備

ワードマクロの実行方法 ~dotmファイルの作成~に記載したステップ①の1~6までを実施した後、ステップ①で、この記事の最後にあるコードを標準モジュールのModule1にコピペします。

コピペすると、以下の状態になります。

vbaエディタ

ワードマクロの実行方法 ~dotmファイルの作成~に記載したステップ①8から22までを行ってください。

ステップ①の11では、「Project.Module1.GrepFIles」を選択してから、追加ボタンを押してください(以下のイラストのようにしてください)

(ステップ①の13では、お好きなアイコンを選んでください)

(ステップ①の20での保存名は何でもいいです)

クイックアクセスツールバーの設定

以上でマクロの準備が完了しました!

このマクロをどのワード文書からも呼び出せるようにしたい場合は、ワードマクロの実行方法 1.dotmファイルの作成に記載したステップ②も行ってください。

このマクロは、既存または作成/編集中の文書ファイル中にある文字列を検索に使用することから、ステップ②を行う方が便利です

マクロの使用方法

以下の手順で簡単にマクロを実行できます(念のためデータのバックアップ後に実行するようにしてください)

1.ご自分のワードファイル(リッチテキストファイルでも可)を開いてください(上記の「マクロの準備」でステップ②まで実施した人)

 ステップ①のみを実施した人はグレップマクロのdotmファイルを開いてください(上部にセキュリティ警告が出た場合は、「コンテンツの有効化」をクリックしてください)

.ワードファイル中の検索したい文字列を選択します。

 以下のイラストでは、「マクロ太郎」を選択しています。

ワード文書

3.左上のアイコンをクリックします

 (アイコンの種類は、上の手順で各自が登録したものになります)

 以下のイラストでは、手のマークです。

マクロ実行用アイコン

4.モードを選択します。

 半角全角の区別のありなしと、小文字大文字の区別のありなしが選べます。

 お好きなモードの数字(全角でも半角でも可)を入力後に、OKボタンを押してください。

入力ダイアログボックス

5.マクロの実行条件を確認します

 以下のメッセージが出るので、内容確認後にOKボタンを押します。

確認メッセージ

 その際、検索用語に改行が含まれていると、以下のメッセージが出ます。

 改行が含まれていてもよい場合は、「はい」を選択します。

確認メッセージ

 このメッセージは、意図せずに検索文字列に改行コードが含まれている場合を考慮して、ユーザーに注意を促すものです。

 (今回の例では、仮に「マクロ太郎」の最後に改行コードが含まれていた場合、検索文字列は「マクロ太郎+改行コード」となるため、改行ありの文末に「マクロ太郎」が存在する場合にのみファイルがヒットすることになります。つまり、連続文字列中の「マクロ太郎」はヒットしません)

 検索文字列に改行が含まれていても検索は問題なくできますが、後述の該当箇所へのジャンプができなくなることだけご注意ください(該当ファイル自体は開けます)。

6.検索したいフォルダを選択します。

 以下のイラストのようなフォルダ選択画面がでますので、検索したいフォルダを選択します。

 (以下のイラスト中の赤丸部分が、検索したいフォルダであることを確認ください)

 フォルダを選択すると、そのフォルダのサブフォルダも含めて検索が自動で始まります

検索フォルダ選択画面

7.検索結果を確認します

 検索が終わると、検索結果をまとめたワードファイルが自動で開きます。

 このワードファイルは、デスクトップに検索結果.docxの名前で保存されています。

 検索結果.docxの内容は以下の通りです。

検索結果例

検索結果は、「フォルダ名:ヒットしたファイル名」の形式になります。

Ctrlキーを押しながら「フォルダ名」をクリックすると、そのフォルダが開きます。

Ctrlキーを押しながら「ファイル名」をクリックすると、そのファイルが開き、検索文字列の位置に自動で移動します。

この自動移動は、ヒットしたファイルがワードファイルまたはリッチテキストファイルの場合にのみ機能します

また、グレップマクロの実行時に検索文字列が自動でクリップボード(メモリ)にコピーされていますので、開いたワードを手動で検索する際に、検索ボックスにCtrl+Vで検索文字列を張り付けることもできます。

注意点

フォルダ内の検索対象ファイル数にご注意ください

検索対象のファイルが大量にあると、それだけ検索時間もかかります。

また、パソコンのスペックによっても検索時間は変わりますので、こうした点にご注意ください。

コード

以下は、グレップマクロのコードです。

上で説明したように標準モジュールにコピペしてご使用ください。

(以下のコードをすべて選択して、そのまま貼り付けてください)

詳細説明に戻る場合はここをクリックしてください。

現在の公開バージョンはV01L13です。

Public distinguishFullHalfWidth As Boolean
Public distinguishCase As Boolean
Public searchResult() As String

Sub GrepFiles()
' V01L13
    Dim folderPath As String
    Dim searchString As String
    Dim currentDocument As Document
    Dim fileDialog As fileDialog
    Dim selectedFile As Variant
    Dim foundFiles As Collection
    Dim foundFile As Variant
    Dim wordFile As Document
    Dim fso As Object
    Dim msgBoxResult As VbMsgBoxResult
    Dim desktopPath As String
    Dim fileName As String
    Dim i As Integer
    Dim mode As Variant
    Dim modeMessage As String
    
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' クリップボードをクリア
    ClearClipboard

    ' 選択範囲が存在するか確認
    If Selection.Start = Selection.End Then
        MsgBox "検索したい文字列を選択してください"
        Exit Sub
    End If

    ' 検索文字列を取得
    searchString = Selection.text
    
    ' searchStringの文字数が230文字を超えている場合、サブルーチンを終了します
    If Len(searchString) > 230 Then
        MsgBox "検索文字列が長すぎます(230文字以内にしてください)。"
        Exit Sub
    End If
    
    mode = InputBox(Prompt:="モードの数字(全角でも半角でも可)を入力してください:" & vbCrLf & vbCrLf & vbCrLf & _
                    " 1: 半角全角の区別なし、小文字大文字の区別なし" & vbCrLf & vbCrLf & _
                    " 2: 半角全角の区別あり、小文字大文字の区別なし" & vbCrLf & vbCrLf & _
                    " 3: 半角全角の区別なし、小文字大文字の区別あり" & vbCrLf & vbCrLf & _
                    " 4: 半角全角の区別あり、小文字大文字の区別あり" & vbCrLf & vbCrLf, _
                    Title:="モード選択")

    'キャンセルの場合は終了
    If mode = "" Then
        If StrPtr(mode) = 0 Then
            Exit Sub
        End If
    End If
    
    Select Case mode
        Case 1
            distinguishFullHalfWidth = False
            distinguishCase = False
            modeMessage = "検索モード:半角全角の区別なし、小文字大文字の区別なし"
        Case 2
            distinguishFullHalfWidth = True
            distinguishCase = False
            modeMessage = "検索モード:半角全角の区別あり、小文字大文字の区別なし"
        Case 3
            distinguishFullHalfWidth = False
            distinguishCase = True
            modeMessage = "検索モード: 半角全角の区別なし、小文字大文字の区別あり"
        Case 4
            distinguishFullHalfWidth = True
            distinguishCase = True
            modeMessage = "検索モード:半角全角の区別あり、小文字大文字の区別あり"
        Case Else
            MsgBox "有効なモードを入力してください"
            Exit Sub
    End Select

    ' ユーザーに確認メッセージを表示
    msgBoxResult = MsgBox("以下の条件で検索します。よろしいですか" & vbCr & vbCr & _
                "検索ワード:" & searchString & vbCr & modeMessage, vbYesNo + vbDefaultButton2, "確認")
    If msgBoxResult = vbNo Then
        Exit Sub ' ユーザーが「いいえ」を選択した場合、処理を終了します。
    End If
    
    '改行コードが含まれている場合に、ユーザーに確認メッセージを表示
    If InStr(searchString, vbCr) > 0 Then
        msgBoxResult = MsgBox("検索ワードに改行が含まれています。よろしいですか", vbYesNo + vbDefaultButton2, "確認")
        If msgBoxResult = vbNo Then
            Exit Sub ' ユーザーが「いいえ」を選択した場合、処理を終了します。
        End If
    End If

    ' フォルダを選択
    Set fileDialog = Application.fileDialog(msoFileDialogFolderPicker)
    fileDialog.Title = "検索フォルダを選択してください"
    If fileDialog.Show = -1 Then
        folderPath = fileDialog.SelectedItems(1)
    Else
        Exit Sub ' ユーザーがキャンセルを選択した場合、処理を終了します。
    End If

    ' 検索結果を保存するためのコレクションを作成
    Set foundFiles = New Collection

    ' デスクトップのパスを取得
    desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")

    ' フォルダ内のすべてのWordファイルとTXTファイルを検索
    SearchFiles fso.GetFolder(folderPath), searchString, foundFiles
    
    ' 検索結果がある場合のみWordファイル名とTXTファイル名を書き出す
    If foundFiles.Count > 0 Then
        i = 1
        Set wordFile = Documents.Add
        wordFile.Content.InsertBefore "ヒットファイル数:" & foundFiles.Count
        wordFile.Content.InsertParagraphAfter
        wordFile.Content.InsertAfter "検索ワード:" & searchString
        wordFile.Content.InsertParagraphAfter
        wordFile.Content.InsertAfter modeMessage
        wordFile.Content.InsertParagraphAfter
        wordFile.Content.InsertAfter "検索フォルダ:" & folderPath
        wordFile.Content.InsertParagraphAfter
        wordFile.Content.InsertParagraphAfter
        For Each foundFile In foundFiles
            wordFile.Hyperlinks.Add Anchor:=wordFile.Paragraphs(wordFile.Paragraphs.Count).Range, Address:=fso.GetParentFolderName(foundFile), TextToDisplay:=Mid(fso.GetParentFolderName(foundFile), Len(fso.GetParentFolderName(folderPath)) + 1)
            wordFile.Content.InsertAfter ":"
            wordFile.Hyperlinks.Add Anchor:=wordFile.Paragraphs(wordFile.Paragraphs.Count).Range.Characters.Last, Address:=foundFile, TextToDisplay:=fso.GetFileName(foundFile), SubAddress:=searchResult(i)
            wordFile.Content.InsertParagraphAfter
        i = i + 1
        Next foundFile
        wordFile.Paragraphs.Last.Range.Delete
        
        ' Wordファイルをデスクトップに保存
        fileName = "検索結果"
        i = 1
        Do While fso.FileExists(desktopPath & "\" & fileName & ".docx")
            fileName = "検索結果" & "(" & i & ")"
            i = i + 1
        Loop
        wordFile.SaveAs desktopPath & "\" & fileName & ".docx"
        ' Wordファイルを開く
        Documents.Open desktopPath & "\" & fileName & ".docx"
        
        ' 検索文字列をクリップボードにコピー
        CopyToClipboard searchString
        
        MsgBox "検索が終了しました。この" & fileName & ".docxは、デスクトップに保存されています"
    Else
        MsgBox "見つかりませんでした"
    End If
    End Sub

Sub SearchFiles(folder As Object, searchString As String, ByRef foundFiles As Collection)
    Dim file As Object
    Dim subfolder As Object
    Dim currentDocument As Document
    Dim currentRange As Range
    Dim found As Boolean
    Dim wasOpen As Boolean
    Dim d As Document
    Dim i As Integer

    ReDim searchResult(0)
    For Each file In folder.Files
        If Right(file.Name, 5) = ".docx" Or Right(file.Name, 4) = ".doc" Or _
            Right(file.Name, 5) = ".DOCX" Or Right(file.Name, 4) = ".DOC" Or _
            Right(file.Name, 4) = ".txt" Or Right(file.Name, 4) = ".TXT" Or _
            Right(file.Name, 4) = ".rtf" Or Right(file.Name, 4) = ".RTF" Then
            On Error Resume Next ' エラーが発生した場合、次のファイルに進みます
            Set currentDocument = Nothing
            wasOpen = False
            For Each d In Documents
                If d.FullName = file.Path Then
                    Set currentDocument = d
                    wasOpen = True
                    Exit For
                End If
            Next d
            If currentDocument Is Nothing Then
                Set currentDocument = Documents.Open(file.Path, ReadOnly:=True) ' ファイルを読み取り専用で開きます
            End If
            If Err.Number = 0 Then ' ファイルが正常に開かれた場合のみ検索を行います
                Set currentRange = currentDocument.Content
                With currentRange.Find
                    .text = searchString
                    .MatchByte = distinguishFullHalfWidth
                    .MatchCase = distinguishCase
                    .MatchFuzzy = False
                    found = .Execute
                End With
                If found Then
                    foundFiles.Add file.Path
                    ReDim Preserve searchResult(UBound(searchResult) + 1)
                    searchResult(UBound(searchResult)) = currentRange.text
                End If
                If Not wasOpen Then
                    currentDocument.Close SaveChanges:=wdDoNotSaveChanges
                End If
            End If
            On Error GoTo 0 ' エラーハンドラをリセットします
        End If
    Next file

    For Each subfolder In folder.Subfolders
        SearchFiles subfolder, searchString, foundFiles
    Next subfolder
End Sub

Sub CopyToClipboard(text As String)
    Dim dataObj As Object
    Set dataObj = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    dataObj.SetText text
    dataObj.PutInClipboard
End Sub

Sub ClearClipboard()
    Dim dataObj As Object
    Set dataObj = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    dataObj.SetText "" ' 空の文字列を設定
    dataObj.PutInClipboard
End Sub

詳細説明に戻る場合はここをクリックしてください。

以上でグレップマクロの紹介は終わりです。

最後まで読んでいただきましてありがとうございました!

他のマクロも是非見て行ってください。

-ワードマクロ集
-, ,