概要
このマクロは、検索文字列を含むファイルの名前と情報をピックアップするマクロ（グレップ（grep）マクロ）です。
普段、文書系ファイル（ワードファイル、テキストファイル、リッチテキストファイル）を扱うことが多い方に役立つと思います。
例えば、ワードファイルの作成中に、
「以前にも似たような文面を書いた／見かけたことがあるな。どのファイルだっけ？」
とふと思った場合に、現在作成中のワードファイル中の文字列を使用して、それを含むファイル（ワードファイル、テキストファイル、リッチテキストファイル）をすぐに検索することができます。
以下に、このマクロの概要をイラストで示します。
詳細説明
マクロの準備
１．ワードマクロの実行方法 ～dotmファイルの作成～に記載したステップ①の１～６までを実施した後、ステップ①の７で、この記事の最後にあるコードを標準モジュールのＭodule1にコピペします。
コピペすると、以下の状態になります。
２．ワードマクロの実行方法 ～dotmファイルの作成～に記載したステップ①の８から２２までを行ってください。
（ステップ①の１１では、「Project.Module1.GrepFIles」を選択してから、追加ボタンを押してください（以下のイラストのようにしてください））
（ステップ①の１３では、お好きなアイコンを選んでください）
（ステップ①の２０での保存名は何でもいいです）
以上でマクロの準備が完了しました！
このマクロをどのワード文書からも呼び出せるようにしたい場合は、ワードマクロの実行方法 １．dotmファイルの作成に記載したステップ②も行ってください。
（このマクロは、既存または作成／編集中の文書ファイル中にある文字列を検索に使用することから、ステップ②を行う方が便利です）
マクロの使用方法
以下の手順で簡単にマクロを実行できます（念のためデータのバックアップ後に実行するようにしてください）
１．ご自分のワードファイル（リッチテキストファイルでも可）を開いてください（上記の「マクロの準備」でステップ②まで実施した人）
ステップ①のみを実施した人はグレップマクロのdotmファイルを開いてください（上部にセキュリティ警告が出た場合は、「コンテンツの有効化」をクリックしてください）
２．ワードファイル中の検索したい文字列を選択します。
以下のイラストでは、「マクロ太郎」を選択しています。
３．左上のアイコンをクリックします
（アイコンの種類は、上の手順で各自が登録したものになります）
以下のイラストでは、手のマークです。
４．モードを選択します。
半角全角の区別のありなしと、小文字大文字の区別のありなしが選べます。
お好きなモードの数字（全角でも半角でも可）を入力後に、OKボタンを押してください。
５．マクロの実行条件を確認します
以下のメッセージが出るので、内容確認後にOKボタンを押します。
その際、検索用語に改行が含まれていると、以下のメッセージが出ます。
改行が含まれていてもよい場合は、「はい」を選択します。
このメッセージは、意図せずに検索文字列に改行コードが含まれている場合を考慮して、ユーザーに注意を促すものです。
（今回の例では、仮に「マクロ太郎」の最後に改行コードが含まれていた場合、検索文字列は「マクロ太郎+改行コード」となるため、改行ありの文末に「マクロ太郎」が存在する場合にのみファイルがヒットすることになります。つまり、連続文字列中の「マクロ太郎」はヒットしません）
検索文字列に改行が含まれていても検索は問題なくできますが、後述の該当箇所へのジャンプができなくなることだけご注意ください（該当ファイル自体は開けます）。
６．検索したいフォルダを選択します。
以下のイラストのようなフォルダ選択画面がでますので、検索したいフォルダを選択します。
（以下のイラスト中の赤丸部分が、検索したいフォルダであることを確認ください）
フォルダを選択すると、そのフォルダのサブフォルダも含めて検索が自動で始まります。
７．検索結果を確認します
検索が終わると、検索結果をまとめたワードファイルが自動で開きます。
このワードファイルは、デスクトップに検索結果.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 & _
" １: 半角全角の区別なし、小文字大文字の区別なし" & vbCrLf & vbCrLf & _
" ２: 半角全角の区別あり、小文字大文字の区別なし" & vbCrLf & vbCrLf & _
" ３: 半角全角の区別なし、小文字大文字の区別あり" & vbCrLf & vbCrLf & _
" ４: 半角全角の区別あり、小文字大文字の区別あり" & 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
詳細説明に戻る場合はここをクリックしてください。
以上でグレップマクロの紹介は終わりです。
最後まで読んでいただきましてありがとうございました！
他のマクロも是非見て行ってください。